Các câu hỏi về mảng trong VBA (Array)

viehoai · 24/3/11

Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị

batman1 · 14/3/19

snow25 đã viết:
Có quy luật gì không ta.Hay cứ lấy hên sui.

Qui luật là bí mật quốc gia. Nhìn kết quả mong đợi rồi đoán thôi.

Vd. bắn lên. Ta đã có thông tin là dòng dưới bắn lên trên (lần này súng bắn một chiều). Nhưng bắn cả dòng dưới lên hay chỉ bắn những ô có dữ liệu của dòng dưới lên? Tôi cho vd.

Giả sử G10 = G11 = hichic. Sau khi bắn thì
- Z10 = 55, Z11 = 600, G10 = G11 = rỗng do G12 = G13 = rỗng bắn lên (bắn cả dòng dưới lên, ghi đè)
- Z10 = 55, Z11 = 600, G10 = G11 = hichic (chỉ bắn các ô <> rỗng của dòng dưới lên trên)

Trường hợp nào đây?

Nếu chỉ bắn các ô <> rỗng của dòng dưới lên trên thì cũng lại có câu hỏi: thế nếu ô tương ứng ở dòng trên đã <> rỗng thì có bắn vào các ô ấy không hay bỏ qua?

Thế nếu có 3 dòng cùng mã thì dòng 3 chỉ bắn lên dòng 2 hay bắn cả lên tới dòng 1?

Tóm lại kết quả mong đợi chỉ là bổ sung cho mô tả. Không thể lấy kết quả mong đợi thay thế cho mô tả khi vấn đề có thể hiểu theo nhiều kiểu.

snow25 · 14/3/19

Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn snow25 đã quan tâm,
Quy luật là copy ở dưới đưa lên cái trên và đưa vào những mã giống nhau ạ.

Bạn xem nhé.

Mã:

Sub laydulieu()
    Dim arr, i As Long, dic As Object, a As Long, b As Long, dk As Long, k As Long, j As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
        arr = .Range("E4:z25").Value
        For i = 1 To UBound(arr, 1) Step 2
            For j = 3 To UBound(arr, 2)
                If Len(arr(i, j)) > 0 Then
                   dic.Item(arr(i, 1)) = i
                   Exit For
                End If
            Next j
        Next i
        For i = 1 To UBound(arr, 1) Step 2
            a = dic.Item(arr(i, 1))
               If a And a <> i Then
                 For k = 0 To 1
                  For j = 3 To UBound(arr, 1)
                      arr(i + k, j) = arr(a + k, j)
                  Next j
                 Next k
               End If
       Next i
       .Range("Ac4:Ax25").Value = arr
   End With

Hoàng Nhật Phương · 14/3/19

Cảm ơn Bác Siwtom và Snow25 đã giúp đỡ.
Đúng như Bác Siwtom đã góp ý bài này có rất nhiều lúc ngược lúc xuôi lúc 2 mã, lúc 3 mã giống nhau... rất nhiều điều kiện (khá rắc rối)
Vì vậy mà OT đã chọn hướng đi khác đi khác rồi ạ.
Chúc Bác & Bạn nhiều sức khỏe.

Hoàng Nhật Phương · 10/4/19

Xin chào các bạn,
Nhờ các bạn giúp OT đỡ trường hợp trong tập tin gửi kèm với ạ.

snow25 · 10/4/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Nhờ các bạn giúp OT đỡ trường hợp trong tập tin gửi kèm với ạ.

Bạn chạy thử sub này nhé.

Mã:

Sub chuyen()
Dim arr, arr1, lr As Long, i As Long, a As Long, j As Long
With Sheet1
    lr = .Range("D" & Rows.Count).End(xlUp).Row
    arr = .Range("D3:aj" & lr).Value
    ReDim arr1(1 To UBound(arr, 1) * 31, 1 To 4)
End With
   For i = 1 To UBound(arr, 1)
       For j = 3 To UBound(arr, 2)
           If arr(i, j) <> Empty Then
              a = a + 1
              arr1(a, 1) = arr(i, 1)
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = j - 2
              arr1(a, 4) = arr(i, j)
           End If
       Next j
   Next i
With Sheet2
      lr = .Range("C" & Rows.Count).End(xlUp).Row
      If lr > 2 Then .Range("C3:F" & lr).ClearContents
      If a Then .Range("c3").Resize(a, 4).Value = arr1
End With
End Sub

Hoàng Nhật Phương · 10/4/19

snow25 đã viết:

Bạn chạy thử sub này nhé.

Mã:

Sub chuyen()
Dim arr, arr1, lr As Long, i As Long, a As Long, j As Long
With Sheet1
    lr = .Range("D" & Rows.Count).End(xlUp).Row
    arr = .Range("D3:aj" & lr).Value
    ReDim arr1(1 To UBound(arr, 1) * 31, 1 To 4)
End With
   For i = 1 To UBound(arr, 1)
       For j = 3 To UBound(arr, 2)
           If arr(i, j) <> Empty Then
              a = a + 1
              arr1(a, 1) = arr(i, 1)
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = j - 2
              arr1(a, 4) = arr(i, j)
           End If
       Next j
   Next i
With Sheet2
      lr = .Range("C" & Rows.Count).End(xlUp).Row
      If lr > 2 Then .Range("C3:F" & lr).ClearContents
      If a Then .Range("c3").Resize(a, 4).Value = arr1
End With
End Sub

Xin cảm ơn Snow25 rất nhiều, kết quả đúng ý OT rồi ạ.

quyenpv · 25/4/19

Với bài toán này các anh xem giúp dùng mảng có trị được không ạ
Hiện em đang phải thực hiện các bước sau để đưa dữ liệu vào 2 Sheet
1. Lấy thủ công số phiếu, ngày xuất vật tư đưa vào Sheet Input_TB cột AS, AT, AU
2. Lấy số lượng, đơn giá vật tư đưa vào Sheet Input_TB theo bảng
3. Căn cứ vào vật tư đã lấy vào Sheet Input_TB đưa sang Sheet BQT_VTU
+ Nếu xuất hiện bao nhiêu lần trong phiếu xuất sẽ có bấy nhiêu dòng bên BQT_VTU
+ Lấy số phiếu, số lượng vật tư, đơn giá tương ứng từ Sheet Input_TB qua Sheet BQT_VTU

Topic nhờ giúp

vanvan9697 · 30/4/19

Em có viết 1 đoạn VBA để tổng hợp bảng kê ra bảng tổng hợp tuy nhiên code sử dụng lại chạy chưa đúng !. anh (chị) sửa lỗi sai giúp em với ạ !

Mã:

Sub TongHop2()
 Dim Data As Variant, Arr(1 To 65536, 1 To 6), i As Long, TenKh As String, j As Long, k As Long
 Data = Sheet2.Range("A2:F15").Value
 If UBound(Data) = 1 Then Exit Sub
    For i = 1 To UBound(Data)
   If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
    If TypeName(Data(i, 1)) = "Double" Then
      k = k + 1
      Arr(k, 1) = TenKh
      Arr(k, 2) = Data(i + 1, 1)
      Arr(k, 3) = Data(i + 1, 2)
      Arr(k, 4) = Data(i + 1, 3)
      Arr(k, 5) = Data(i + 1, 4)
      Arr(k, 6) = Data(i + 1, 5)
    End If
    Next
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
End Sub

leonguyenz · 30/4/19

vanvan9697 đã viết:
Em có viết 1 đoạn VBA để tổng hợp bảng kê ra bảng tổng hợp tuy nhiên code sử dụng lại chạy chưa đúng !. anh (chị) sửa lỗi sai giúp em với ạ !

Mã:

Sub TongHop2() Dim Data As Variant, Arr(1 To 65536, 1 To 6), i As Long, TenKh As String, j As Long, k As Long Data = Sheet2.Range("A2:F15").Value If UBound(Data) = 1 Then Exit Sub For i = 1 To UBound(Data) If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2) If TypeName(Data(i, 1)) = "Double" Then k = k + 1 Arr(k, 1) = TenKh Arr(k, 2) = Data(i + 1, 1) Arr(k, 3) = Data(i + 1, 2) Arr(k, 4) = Data(i + 1, 3) Arr(k, 5) = Data(i + 1, 4) Arr(k, 6) = Data(i + 1, 5) End If Next If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr End Sub

Bạn xem file đính kèm

Mã:

Sub TongHop2()
Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
ReDim Arr(1 To UBound(Data, 1), 1 To 7)
    For i = 1 To UBound(Data)
        If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
        If IsDate(Data(i, 1)) Then
            k = k + 1
            Arr(k, 1) = TenKh
            For j = 1 To 6
                Arr(k, j + 1) = Data(i, j)
            Next j
        End If
    Next i
If k Then
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Sheet2.Range("H2").Resize(k, 7).Value = Arr
End If
End Sub

vanvan9697 · 30/4/19

leonguyenz đã viết:

Bạn xem file đính kèm

Mã:

Sub TongHop2()
Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
ReDim Arr(1 To UBound(Data, 1), 1 To 7)
    For i = 1 To UBound(Data)
        If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
        If IsDate(Data(i, 1)) Then
            k = k + 1
            Arr(k, 1) = TenKh
            For j = 1 To 6
                Arr(k, j + 1) = Data(i, j)
            Next j
        End If
    Next i
If k Then
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Sheet2.Range("H2").Resize(k, 7).Value = Arr
End If
End Sub

Dạ em cảm ơn anh ạ !

SA_DQ · 30/4/19

Các bạn chưa xóa dữ liệu trong lần chạy trước
Nếu trường hợp làn chạy sau có chỉ số K bé hơn lần trước thì kết quả sẽ là trời ơi!

vanvan9697 · 30/4/19

SA_DQ đã viết:
Các bạn chưa xóa dữ liệu trong lần chạy trước
Nếu trường hợp làn chạy sau có chỉ số K bé hơn lần trước thì kết quả sẽ là trời ơi!

Dạ em chưa hiểu vấn đề của anh, anh có thể giải thích rõ hơn cho em 1 chút được không ạ !

SA_DQ · 30/4/19

Với câu lệnh này
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
Thì có thể có 2 trương hợp sẩy ra:

(1) Lần chạy macro lần trước K=9 (giả dụ)
Lần này chỉ có K=7
Vậy thì 2 dòng dữ liệu của lần chạy trước còn nguyên xi & bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu, thay vì 7

(2) Nếu lần chạy macro sau có số dòng bằng hoặc lớn hơn lần chạy trước thì bạn đã tiết kiệm được 1 dòng lệnh & không đán để được chúc mừng đâu!

vanvan9697 · 30/4/19

SA_DQ đã viết:
Với câu lệnh này
If k Then Sheet2.Range("H2").Resize(k, 6).Value = Arr
Thì có thể có 2 trương hợp sẩy ra:

(1) Lần chạy macro lần trước K=9 (giả dụ)
Lần này chỉ có K=7
Vậy thì 2 dòng dữ liệu của lần chạy trước còn nguyên xi & bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu, thay vì 7

(2) Nếu lần chạy macro sau có số dòng bằng hoặc lớn hơn lần chạy trước thì bạn đã tiết kiệm được 1 dòng lệnh & không đán để được chúc mừng đâu!

Vậy có nghĩa là trước khi ghi dữ liệu sẽ xóa đi rồi câu lệnh đó là k >0 đúng không anh !

batman1 · 30/4/19

SA_DQ đã viết:
Các bạn chưa xóa dữ liệu trong lần chạy trước
...
(1) Lần chạy macro lần trước K=9 (giả dụ)
Lần này chỉ có K=7
Vậy thì 2 dòng dữ liệu của lần chạy trước còn nguyên xi & bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu, thay vì 7

Cái này không đúng. Vì nếu k = 7 thì có nghĩa là k > 0, tức dòng

Mã:

Sheet2.Range("H2").Resize(1000, 7).ClearContents

sẽ được thực hiện nên không có chuyện "bạn sẽ vẫn tưởng kết quả của macro đem lại vẫn 9 dòng dữ liệu". Dòng trên là của leonguyenz mà bạn viết

Các bạn chưa xóa dữ liệu trong lần chạy trước

thì không đúng.

Tất nhiên phải xóa dữ liệu cũ nhưng lý do không phải là "Nếu trường hợp làn chạy sau có chỉ số K bé hơn lần trước thì kết quả sẽ là trời ơi!" mà là "Nếu trường hợp làn chạy sau có chỉ số K = 0 thì kết quả sẽ là trời ơi!". Tại sao? Vì khi k = 0 thì lẽ ra phải là không có kết quả nhưng do k = 0 nên code trong If k Then ... End If của leonguyenz không được thực hiện nên kết quả cũ không được xóa, và người ta hiểu lầm là vẫn có kết quả.

Code của leonguyenz có xóa kết quả cũ nhưng chưa chuẩn vì chỉ xóa khi k > 0 mà không xóa khi k = 0.

Lôgíc là: trước hết xóa kết quả cũ sau đó chạy code còn lại. Nếu sau đó không có dữ liệu thỏa điều kiện thì ắt hẳn k = 0 và lúc đó "vùng kết quả trắng tinh" (do trước đó vùng kết quả đã được xóa). Nếu sau đó k > 0 thì kết quả có bao nhiêu thì sẽ được nhập vào vùng kết quả bấy nhiêu, không thừa và cũng không thiếu, vừa vặn.

Tóm lại trong code của leonguyenz
- xóa dòng

Mã:

Sheet2.Range("H2").Resize(1000, 7).ClearContents

- trước dòng

Mã:

Data = Sheet2.Range("A2:F15").Value

thì thêm dòng

Mã:

Sheet2.Range("H2").Resize(1000, 7).ClearContents

Nói cách khác: hãy chuyển dòng

Mã:

Sheet2.Range("H2").Resize(1000, 7).ClearContents

lên đầu.

Nếu dữ liệu rất nhiều và có khả năng kết quả > 1000 thì sửa 1000 thành số "đủ lớn". Hoặc xác định dòng cuối cùng trong vùng kết quả cũ để xóa hết kết quả cũ.

Hoàng Nhật Phương · 1/5/19

leonguyenz đã viết:

Bạn xem file đính kèm

Mã:

Sub TongHop2()
Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
Data = Sheet2.Range("A2:F15").Value
ReDim Arr(1 To UBound(Data, 1), 1 To 7)
    For i = 1 To UBound(Data)
        If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
        If IsDate(Data(i, 1)) Then
            k = k + 1
            Arr(k, 1) = TenKh
            For j = 1 To 6
                Arr(k, j + 1) = Data(i, j)
            Next j
        End If
    Next i
If k Then
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Sheet2.Range("H2").Resize(k, 7).Value = Arr
End If
End Sub

Xin chào các bạn,
Với code trên của anh leonguyenz , Oanh Thơ đang thử loay hoay với cách sử dụng ReDim Preserve cho mảng Arr, sao cho chiều thứ nhất số phần thử trong mảng bằng k.
Nhưng chưa biết xử lý thế nào, code chạy toàn báo lỗi nhờ các bạn chỉ dẫn ạ

tam888 · 1/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Với code trên của anh leonguyenz , Oanh Thơ đang thử loay hoay với cách sử dụng ReDim Preserve cho mảng Arr, sao cho chiều thứ nhất số phần thử trong mảng bằng k.
Nhưng chưa biết xử lý thế nào, code chạy toàn báo lỗi nhờ các bạn chỉ dẫn ạ

Với VBA: Redim Preserve chỉ cho thay đổi chiều cuối của mảng, tức là mảng 2 chiều thì cho thay đổi theo chiều thứ 2 (cột) của mảng . Nên theo k là không thể

VetMini · 2/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
...cách sử dụng ReDim Preserve cho mảng Arr, sao cho chiều thứ nhất số phần thử trong mảng bằng k.
Nhưng chưa biết xử lý thế nào, code chạy toàn báo lỗi nhờ các bạn chỉ dẫn ạ

Lại "chạy toàn báo lỗi" !!! Lỗi gì? Ở dòng nào?

Mảng 2 chiều phải không? Chịu khó tìm, vấn đề này và các cách giải quyết đã từng được bàn qua rồi.

Hoàng Nhật Phương · 2/5/19

Xin chào tam888, Bác VetMini,
Cảm ơn mọi người đã giúp đỡ Oanh Thơ ạ.

VetMini đã viết:
Lại "chạy toàn báo lỗi" !!! Lỗi gì? Ở dòng nào?
Mảng 2 chiều phải không? Chịu khó tìm, vấn đề này và các cách giải quyết đã từng được bàn qua rồi.

Híc, con xin lỗi Bác con quên mất ..
nó bị lỗi "Subscript out of range" tại dòng ReDim Preserve Arr(1 To k, 1 To 7)
Nhờ Bác chỉ dẫn thêm cho ạ.

Mã:

Sub TongHop2()
    Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long
    Sheet2.Range("H2").Resize(1000, 7).ClearContents
    Data = Sheet2.Range("A2:F15").Value
    ReDim Arr(1 To UBound(Data, 1), 1 To 7)
        For i = 1 To UBound(Data)
            If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2)
            If IsDate(Data(i, 1)) Then
                k = k + 1
                ReDim Preserve Arr(1 To k, 1 To 7)
                Arr(k, 1) = TenKh
                For j = 1 To 6
                    Arr(k, j + 1) = Data(i, j)
                Next j
            End If
        Next i
    If k Then
        Sheet2.Range("H2").Resize(k, 7).Value = Arr
    End If
End Sub

snow25 · 2/5/19

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tam888, Bác VetMini,
Cảm ơn mọi người đã giúp đỡ Oanh Thơ ạ.

Híc, con xin lỗi Bác con quên mất ..
nó bị lỗi "Subscript out of range" tại dòng ReDim Preserve Arr(1 To k, 1 To 7)
Nhờ Bác chỉ dẫn thêm cho ạ.

Mã:

Sub TongHop2() Dim Data(), Arr(), i As Long, TenKh As String, j As Long, k As Long Sheet2.Range("H2").Resize(1000, 7).ClearContents Data = Sheet2.Range("A2:F15").Value ReDim Arr(1 To UBound(Data, 1), 1 To 7) For i = 1 To UBound(Data) If Data(i, 1) = "Tên KH" Then TenKh = Data(i, 2) If IsDate(Data(i, 1)) Then k = k + 1 ReDim Preserve Arr(1 To k, 1 To 7) Arr(k, 1) = TenKh For j = 1 To 6 Arr(k, j + 1) = Data(i, j) Next j End If Next i If k Then Sheet2.Range("H2").Resize(k, 7).Value = Arr End If End Sub

Bỏ dòng đó đi là được.

Các câu hỏi về mảng trong VBA (Array)

Thành viên gắn bó

Thành viên gạo cội

Thành viên gạo cội

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

Thành viên gạo cội

Thành viên gắn bó

Thu nhặt kiến thức

File đính kèm

Thành viên chính thức

File đính kèm

Thành viên gạo cội

File đính kèm

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

/(hông là gì!

Thành viên chính thức

Thành viên gạo cội

Thành viên gắn bó

Thành viên tích cực

Ăn cùng góc phố

Thành viên gắn bó

Thành viên gạo cội