تخزين الخلايا الظاهرة فقط الى مصفوفة

[محمد ايمن]

الاصدقاء الاكارم تحية طيبة

الكود التالي ينسخ الخلايا الظاهرة فقط الى مصفوفة

توجد مشكلة وهي ان الكود يخزن الخلايا المتسلسلة فقط

في الصورة الخلايا المحددة حسب التاريخ هي من 1 الى 12 و الخلية 16

يتم تخزين الخلايا من 1 الى 12 فقط

ماهو الحل ليتم تخزين كافة الخلايا ضمن المصفوفة

Public Sub FixInvoiceByArry()
Dim rr1, i As Double, ii As Double, lr As Double, V1 As Variant
Dim VInvoiceNumber As Long
Dim VInvoiceValue As Double
Dim VInvoiceDate As Variant
Dim VInvoiceAddress As Variant

If MsgBox("هل تريد تحديث الفواتير ؟", vbExclamation + vbMsgBoxRight + vbYesNo) = vbYes Then

lr = sheet5.Cells(Rows.Count, 1).End(xlUp).Row
rr1 = sheet5.Range("a2:G" & lr).SpecialCells(xlCellTypeVisible).EntireRow



ReDim Preserve rr1(1 To UBound(rr1), 1 To 7)


For i = 1 To UBound(rr1, 1)
VInvoiceNumber = rr1(i, 3)
VInvoiceDate = rr1(i, 2)

If VInvoiceNumber <> 0 Then
MsgBox rr1(i, 3)

End If
Next
End If
End Sub

المصنف1.xlsm

[lionheart]

As an idea, you can copy the visible cells to unused range then store the range into array

Sub Test()
    Dim a, m As Long
    With ActiveSheet
        m = .Cells(Rows.Count, 1).End(xlUp).Row + 10
        .Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible).Copy .Range("A" & m)
        a = .Range("A" & m).CurrentRegion.Value
        .Range("A" & m).CurrentRegion.Clear
    End With
End Sub

 

[محمد ايمن]

مشكور اخي على الرد و لكن للاسف هناك مشكلة الكود لا ينسخ كافة الاعمدة

[lionheart]

Did you try the code on the same file you attached

[محمد ايمن]

[محمد ايمن]

ملاحظة : يجب ان يتم نسخ كافة الاعمدة حتى لو كانت مخفية اما الصفوف يتم نسخ الصفوف الظاهرة فقط

[lionheart]

Sub Test()
    Dim a, e, c As Range, sCols As String, m As Long
    Application.ScreenUpdating = False
        With ActiveSheet
            m = .Cells(Rows.Count, 1).End(xlUp).Row + 10
            With .Range("A1").CurrentRegion
                For Each c In .Rows(1).Cells
                    If c.EntireColumn.Hidden Then sCols = sCols & IIf(sCols = "", "", "|") & c.Column
                Next c
                .EntireColumn.Hidden = False
                .Offset(1).SpecialCells(xlCellTypeVisible).Copy .Parent.Range("A" & m)
            End With
            With .Range("A" & m).CurrentRegion
                a = .Value: .Clear
            End With
            For Each e In Split(sCols, "|")
                .Columns(Val(e)).Hidden = True
            Next e
        End With
    Application.ScreenUpdating = True
End Sub

 

[محمد ايمن]

جزاك الله كل خير وهو المطلوب بعينه لو امكن ان تشرح الكود

[lionheart]

The code is som simple and self-exaplanatory

First stored the hidden columns in a variable then dislay the hidden columns then copy the visible rows only to an unused range and store the new range into the array and finally hide the hidden columns again