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

[viehoai]

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ị

 

[xuancong_2010]

Sub Macro1()
    Dim i As Byte, j As Byte, k As Byte
    k = 3
    For i = 1 To k
        For j = i + 1 To k
            MsgBox j
        Next
    Next
End Sub

Qua phần thí nghiệm này bạn sẽ thấy j chạy bỏ qua số 1 và không đạt tới k +1. Theo bạn, bạn muốn j như thế nào?

của e là đếm số lần xuất hiện phần tử trong mảng, do đó j của e chạy từ 2 đến hết, đoạn cuối là e cũng tính Arr(j, 1) = 0
mà ở ngoài vòng lặp i có điều kiện Arr(j, 1) <> 0 từ đó lọc bỏ qua trường hợp lỗi cuối cùng @@

 

[Hoàng Trọng Nghĩa]

của e là đếm số lần xuất hiện phần tử trong mảng, do đó j của e chạy từ 2 đến hết, đoạn cuối là e cũng tính Arr(j, 1) = 0
mà ở ngoài vòng lặp i có điều kiện Arr(j, 1) <> 0 từ đó lọc bỏ qua trường hợp lỗi cuối cùng @@

Chúng ta lại thử thí nghiệm 2, không cần 2 vòng lặp, bạn thấy thế nào?

Sub Macro2()
    Dim i As Byte, j As Byte, k As Byte
    k = 3
    For i = 1 To k
        j = i + 1
        MsgBox j
    Next
End Sub

 

[xuancong_2010]

Chúng ta lại thử thí nghiệm 2, không cần 2 vòng lặp, bạn thấy thế nào?

Sub Macro2()
    Dim i As Byte, j As Byte, k As Byte
    k = 3
    For i = 1 To k
        j = i + 1
        MsgBox j
    Next
End Sub

như thế e sẽ ko so sánh được với các phần tử còn lại, và k đếm được số lần xuất hiện của phần tử đấy trong mảng. e làm hơi thủ công chút @@

 

[Hoàng Trọng Nghĩa]

như thế e sẽ ko so sánh được với các phần tử còn lại, và k đếm được số lần xuất hiện của phần tử đấy trong mảng. e làm hơi thủ công chút @@

Bạn đưa cái sub mà bạn đã hoàn thiện lên đây tôi xem có rút gọn được không? Thấy sơ sơ là đã loại bỏ được 1 vòng lặp rồi đấy.

 

[xuancong_2010]

Bạn đưa cái sub mà bạn đã hoàn thiện lên đây tôi xem có rút gọn được không? Thấy sơ sơ là đã loại bỏ được 1 vòng lặp rồi đấy.

Sub tinh()
    Dim gan, lrow2, lrow
    Dim i, j, k, dem As Integer
    Dim Arr, arr1
    lrow = Range("C" & Rows.Count).End(xlUp).Row
 
    ReDim lrow2(1 To lrow - 5, 1 To 3)
    lrow2 = Range("C6:E" & lrow)
 
    ReDim Arr(1 To UBound(lrow2), 1 To 1)
    ReDim gan(1 To UBound(lrow2), 1 To 1)
    ReDim arr1(1 To UBound(lrow2), 1 To 1)
 
    For i = 1 To UBound(lrow2)
        Arr(i, 1) = -1
    Next
 
    For i = 1 To UBound(lrow2)
        dem = 1
        For j = i + 1 To UBound(lrow2)
     
            If lrow2(j, 1) = lrow2(i, 1) Then
                dem = dem + 1
                Arr(j, 1) = 0
            End If
         
        Next
     
        If Arr(i, 1) <> 0 Then
            k = k + 1
            Arr(i, 1) = dem
            arr1(k, 1) = Arr(i, 1)
            gan(k, 1) = lrow2(i, 1)
        End If
 
    Next
 
        Range("M6:M" & lrow) = arr1
        Range("O6:O" & lrow) = gan
End Sub

Thầy xem giúp hộ e với

 

[Hoàng Trọng Nghĩa]

Sub tinh()
    Dim gan, lrow2, lrow
    Dim i, j, k, dem As Integer
    Dim Arr, arr1
    lrow = Range("C" & Rows.Count).End(xlUp).Row
 
    ReDim lrow2(1 To lrow - 5, 1 To 3)
    lrow2 = Range("C6:E" & lrow)
 
    ReDim Arr(1 To UBound(lrow2), 1 To 1)
    ReDim gan(1 To UBound(lrow2), 1 To 1)
    ReDim arr1(1 To UBound(lrow2), 1 To 1)
 
    For i = 1 To UBound(lrow2)
        Arr(i, 1) = -1
    Next
 
    For i = 1 To UBound(lrow2)
        dem = 1
        For j = i + 1 To UBound(lrow2)
    
            If lrow2(j, 1) = lrow2(i, 1) Then
                dem = dem + 1
                Arr(j, 1) = 0
            End If
        
        Next
    
        If Arr(i, 1) <> 0 Then
            k = k + 1
            Arr(i, 1) = dem
            arr1(k, 1) = Arr(i, 1)
            gan(k, 1) = lrow2(i, 1)
        End If
 
    Next
 
        Range("M6:M" & lrow) = arr1
        Range("O6:O" & lrow) = gan
End Sub

Thầy xem giúp hộ e với

Bạn làm gì với nó? Bạn vui lòng gửi file lên tôi xem được không? Nhưng trước mắt bạn cần phải đặt biến cho tường minh và đúng kiểu dữ liệu.
Đúng kiểu dữ liệu là thế này, trước tiên ta hãy nhìn bảng này:



Bạn đặt biến dem dạng Integer, mà max của biến này chỉ có hơn 32k thôi, trong khi Excel 2003 nó đã hơn 65k dòng rồi, nếu giả sử một ngày nào đó dữ liệu của bạn hơn 32k thì chắc chắn code sẽ báo lỗi, vì thế trong trường hợp này tôi tư vấn cho bạn nên đặt biến dạng Long.

Vả lại trừ là biến Variant thì không cần kiểu dữ liệu như Dim Arr, Arr1, nhưng kiểu Dim i, j, k, dem As Integer được hiểu i, j, k là biến thuộc kiểu Variant chỉ có dem được hiểu là Integer thôi, vì thế thôi nghĩ bạn bạn nên khai báo đại loại như vầy:

Dim Arr, Arr1, ArrGan, ArrRow
Dim i As Long, j As Long, k As Long, lngDem As Long, lngRow As Long

Nói nhiều vậy thôi, nhưng bạn gửi cho tôi cái file xem bạn làm gì và kết quả cần có là gì tôi sẽ rút gọn hoặc tăng tốc cho bạn.

 

[Hoàng Trọng Nghĩa]

Sub tinh()
    Dim gan, lrow2, lrow
    Dim i, j, k, dem As Integer
    Dim Arr, arr1
    lrow = Range("C" & Rows.Count).End(xlUp).Row
 
    ReDim lrow2(1 To lrow - 5, 1 To 3)
    lrow2 = Range("C6:E" & lrow)
 
    ReDim Arr(1 To UBound(lrow2), 1 To 1)
    ReDim gan(1 To UBound(lrow2), 1 To 1)
    ReDim arr1(1 To UBound(lrow2), 1 To 1)
 
    For i = 1 To UBound(lrow2)
        Arr(i, 1) = -1
    Next
 
    For i = 1 To UBound(lrow2)
        dem = 1
        For j = i + 1 To UBound(lrow2)
    
            If lrow2(j, 1) = lrow2(i, 1) Then
                dem = dem + 1
                Arr(j, 1) = 0
            End If
        
        Next
    
        If Arr(i, 1) <> 0 Then
            k = k + 1
            Arr(i, 1) = dem
            arr1(k, 1) = Arr(i, 1)
            gan(k, 1) = lrow2(i, 1)
        End If
 
    Next
 
        Range("M6:M" & lrow) = arr1
        Range("O6:O" & lrow) = gan
End Sub

Thầy xem giúp hộ e với

Bạn thử dùng thủ tục này xem có gì sai không? Nếu nó đúng phải chăng là đã bớt đi 1 vòng lặp rồi không?

Sub Tinh_HTN()
    Dim Arr, Arr1, ArrGan, ArrRow
    Dim i As Long, j As Long, k As Long, lngDem  As Long, lngRow As Long
    lngRow = Range("C" & Rows.Count).End(xlUp).Row
    ReDim ArrRow(1 To lngRow - 5, 1 To 3)
    ArrRow = Range("C6:E" & lngRow)
 
    ReDim Arr(1 To UBound(ArrRow), 1 To 1)
    ReDim ArrGan(1 To UBound(ArrRow), 1 To 1)
    ReDim Arr1(1 To UBound(ArrRow), 1 To 1)
 
    For i = 1 To UBound(ArrRow)
        Arr(i, 1) = -1
    Next
 
    For i = 1 To UBound(ArrRow)
        j = i + 1
        lngDem = 1
        If ArrRow(j, 1) = ArrRow(i, 1) Then
            lngDem = lngDem + 1
            Arr(j, 1) = 0
        End If
    
        If Arr(i, 1) <> 0 Then
            k = k + 1
            Arr(i, 1) = lngDem
            Arr1(k, 1) = Arr(i, 1)
            ArrGan(k, 1) = ArrRow(i, 1)
        End If
 
    Next
 
        Range("M6:M" & lngRow) = Arr1
        Range("O6:O" & lngRow) = ArrGan
End Sub

 

[HieuCD]

Sub tinh()
    Dim gan, lrow2, lrow
    Dim i, j, k, dem As Integer
    Dim Arr, arr1
    lrow = Range("C" & Rows.Count).End(xlUp).Row
 
    ReDim lrow2(1 To lrow - 5, 1 To 3)
    lrow2 = Range("C6:E" & lrow)
 
    ReDim Arr(1 To UBound(lrow2), 1 To 1)
    ReDim gan(1 To UBound(lrow2), 1 To 1)
    ReDim arr1(1 To UBound(lrow2), 1 To 1)
 
    For i = 1 To UBound(lrow2)
        Arr(i, 1) = -1
    Next
 
    For i = 1 To UBound(lrow2)
        dem = 1
        For j = i + 1 To UBound(lrow2)
   
            If lrow2(j, 1) = lrow2(i, 1) Then
                dem = dem + 1
                Arr(j, 1) = 0
            End If
       
        Next
   
        If Arr(i, 1) <> 0 Then
            k = k + 1
            Arr(i, 1) = dem
            arr1(k, 1) = Arr(i, 1)
            gan(k, 1) = lrow2(i, 1)
        End If
 
    Next
 
        Range("M6:M" & lrow) = arr1
        Range("O6:O" & lrow) = gan
End Sub

Thầy xem giúp hộ e với

Bài nầy dùng 2 vòng For lồng nhau, nếu dùng Dic chỉ cần 1 vòng for

Sub tinh()
  Dim sArr(), res(), res2()
  Dim eRow&, sRow&, i&, k&, tmp
  Const LoaiTru$ = "1a!2b@"
 
  eRow = Range("C" & Rows.Count).End(xlUp).Row
  sArr = Range("C6:C" & eRow).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 1)
  ReDim res2(1 To sRow, 1 To 1)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    If tmp <> LoaiTru Then
      k = k + 1
      res(k, 1) = 1
      res2(k, 1) = tmp
      For r = i + 1 To sRow
        If sArr(r, 1) = tmp Then
          res(k, 1) = res(k, 1) + 1
          sArr(r, 1) = LoaiTru
        End If
      Next r
    End If
  Next i
  Range("M6:M" & eRow) = res
  Range("O6:O" & eRow) = res2
End Sub

Sub tinh2()
  Dim sArr(), res(), res2(), dic As Object
  Dim eRow&, sRow&, i&, k&
 
  Set dic = CreateObject("scripting.dictionary")
  eRow = Range("C" & Rows.Count).End(xlUp).Row
  sArr = Range("C6:C" & eRow).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 1)
  ReDim res2(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If dic.exists(sArr(i, 1)) = False Then
      k = k + 1
      res2(k, 1) = sArr(i, 1)
      dic.Add sArr(i, 1), k
    End If
    ik = dic.Item(sArr(i, 1))
    res(ik, 1) = res(ik, 1) + 1
  Next i
  Range("M6:M" & eRow) = res
  Range("O6:O" & eRow) = res2
End Sub

 

[xuancong_2010]

Bạn đưa cái sub mà bạn đã hoàn thiện lên đây tôi xem có rút gọn được không? Thấy sơ sơ là đã loại bỏ được 1 vòng lặp rồi đấy.

Bài nầy dùng 2 vòng For lồng nhau, nếu dùng Dic chỉ cần 1 vòng for

Sub tinh()
  Dim sArr(), res(), res2()
  Dim eRow&, sRow&, i&, k&, tmp
  Const LoaiTru$ = "1a!2b@"
 
  eRow = Range("C" & Rows.Count).End(xlUp).Row
  sArr = Range("C6:C" & eRow).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 1)
  ReDim res2(1 To sRow, 1 To 1)
  For i = 1 To sRow
    tmp = sArr(i, 1)
    If tmp <> LoaiTru Then
      k = k + 1
      res(k, 1) = 1
      res2(k, 1) = tmp
      For r = i + 1 To sRow
        If sArr(r, 1) = tmp Then
          res(k, 1) = res(k, 1) + 1
          sArr(r, 1) = LoaiTru
        End If
      Next r
    End If
  Next i
  Range("M6:M" & eRow) = res
  Range("O6:O" & eRow) = res2
End Sub

Sub tinh2()
  Dim sArr(), res(), res2(), dic As Object
  Dim eRow&, sRow&, i&, k&
 
  Set dic = CreateObject("scripting.dictionary")
  eRow = Range("C" & Rows.Count).End(xlUp).Row
  sArr = Range("C6:C" & eRow).Value
  sRow = UBound(sArr)
  ReDim res(1 To sRow, 1 To 1)
  ReDim res2(1 To sRow, 1 To 1)
  For i = 1 To sRow
    If dic.exists(sArr(i, 1)) = False Then
      k = k + 1
      res2(k, 1) = sArr(i, 1)
      dic.Add sArr(i, 1), k
    End If
    ik = dic.Item(sArr(i, 1))
    res(ik, 1) = res(ik, 1) + 1
  Next i
  Range("M6:M" & eRow) = res
  Range("O6:O" & eRow) = res2
End Sub

em mới học nên đang đến phần mảng chưa rõ về Dic cho lắm

Bài đã được tự động gộp: 21/8/21

Bạn thử dùng thủ tục này xem có gì sai không? Nếu nó đúng phải chăng là đã bớt đi 1 vòng lặp rồi không?

Sub Tinh_HTN()
    Dim Arr, Arr1, ArrGan, ArrRow
    Dim i As Long, j As Long, k As Long, lngDem  As Long, lngRow As Long
    lngRow = Range("C" & Rows.Count).End(xlUp).Row
    ReDim ArrRow(1 To lngRow - 5, 1 To 3)
    ArrRow = Range("C6:E" & lngRow)
 
    ReDim Arr(1 To UBound(ArrRow), 1 To 1)
    ReDim ArrGan(1 To UBound(ArrRow), 1 To 1)
    ReDim Arr1(1 To UBound(ArrRow), 1 To 1)
 
    For i = 1 To UBound(ArrRow)
        Arr(i, 1) = -1
    Next
 
    For i = 1 To UBound(ArrRow)
        j = i + 1
        lngDem = 1
        If ArrRow(j, 1) = ArrRow(i, 1) Then
            lngDem = lngDem + 1
            Arr(j, 1) = 0
        End If
  
        If Arr(i, 1) <> 0 Then
            k = k + 1
            Arr(i, 1) = lngDem
            Arr1(k, 1) = Arr(i, 1)
            ArrGan(k, 1) = ArrRow(i, 1)
        End If
 
    Next
 
        Range("M6:M" & lngRow) = Arr1
        Range("O6:O" & lngRow) = ArrGan
End Sub

của em là so sánh số lần xuất hiện trong mảng, hôm nay em mới về nhà, mới gửi đc file của em các Thầy giúp em thêm phần lấy phần dữ liệu trong cùng mảng đấy với. em cám ơn

 

[xuancong_2010]

em mới học nên đang đến phần mảng chưa rõ về Dic cho lắm

Bài đã được tự động gộp: 21/8/21

của em là so sánh số lần xuất hiện trong mảng, hôm nay em mới về nhà, mới gửi đc file của em các Thầy giúp em thêm phần lấy phần dữ liệu trong cùng mảng đấy với. em cám ơn

tôi đã tự làm xong ý tưởng cám ơn các thầy và mọi người vì những bài ở trên diễn đàn có rất nhiều VD hữu ích khi học code

 

[Ngày mai trời lại sáng]

Chào mọi người.

Em khai báo mảng ban đầu như sau arr ( 1 to 10000, 1 to 100)
các giá trị từ 1 đến 1000 & từ 1 đến 100 được gán bởi nhiều tham số :x,y,z, a,b,c .v... x= a +b, y=c ,v.v.v.. do áp dụng dictionary nên các tham số ngang dọc này nhảy nhót không theo lần lượt như vòng lặp 1,2,3... , khi thỏa mãn điều kiện thì sẽ trả về giá trị.

vấn đề là khi kết thúc vòng lặp em mới thấy được giá trị của mảng arr(1289,28)= 2000
Vậy làm thế nào để em có thể debug dừng lại tại đúng chỉ số mảng arr(1289,28) ? để xác định nguyên nhân?

 

[befaint]

dừng lại tại đúng chỉ số mảng arr(1289,28)

Lập trình thì khi hỏi cứ bê cái khúc cốt đó lên đây. Hỏi suông thì chỉ nhận được câu trả lời văn xuôi, rồi lại mò tới khi nào mới xong việc.

For i = 1289 to 1289
For j = 28 to 28
'
Next j
Next i

Hoặc
If i = 1289 and j = 28 then msgbox nó.

 

[Ngày mai trời lại sáng]

Lập trình thì khi hỏi cứ bê cái khúc cốt đó lên đây. Hỏi suông thì chỉ nhận được câu trả lời văn xuôi, rồi lại mò tới khi nào mới xong việc.

For i = 1289 to 1289
For j = 28 to 28
'
Next j
Next i

Hoặc
If i = 1289 and j = 28 then msgbox nó.

em làm kiểu như thế này, nhưg em đã dò ra rồi , tìm mãi for j em không biết lồng kiểu gì :

For i = 1 to 10000
....
a=dic.item(data(i, 3))
b = data(i, 7)
c = dic.item(b)
d = data(i, 18)
e = dic.item(d)
....
arr(a + 9, e) = arr(a + 9, e) - arr(a +5, c)
...
Next i

 

[doccohaiau]

Mọi người cho mình hỏi về đoạn code như mình tóm tắt nội dung ở dưới.
Nội dung mình cần hỏi: "Đề xuất Giải pháp tốc độ nhanh nhất hiển thị ra kết quả".
Hoặc thay đổi nội dung code hoặc kết hợp với cái gì ý ạ. Nếu là có API thì cho mình xin tên Hàm. Hoặc có Class thì cho mình xin gợi ý cách viết ạ.
Chứ 2 cái món này mình mòm mẫm mãi vẫn chưa hiểu về nó.
Xin cảm ơn mọi người!
'======================================================

Dim iArr(), ResI As String
Dim kArr(), ResK As String
Dim iRow As Long, iCol As Long
Dim iR As Long, iC As Long, i As Long
Dim kR As Long, kC As Long, k As Long
Dim ik As Integer, kk As Long
Dim iCount As Integer, iDem As Integer
Dim tArr(), ResT As String

'For iR = 1 To iRow - 1
''    For iC = 1 To iCol 'Max 9
        ResT = tArr(iR, iC)     'Giá trị dựa theo iR là chính, iC có thể xử lý riêng.    '
''    Next iC
'Next iR
'///////////Mảng iArr được đổ trực tiếp từ Excel hoặc SQL.
For iR = 1 To iRow              'Thay đổi từ      3-20.000
    For iC = 1 To iCol          'Thay đổi từ     1-110   
        ResI = iArr(iR, iC)
            For kR = 1 To k     'Thay đổi từ   1-110
                'Xử lý theo Điều kiện để ra ResKr
                ResKr = Mid(ResI, kR, ik)       'iK Thay đổi từ 1-10
                For kC = 1 To k
                    'Xử lý theo Điều kiện để ra ResKc
                    ResKc = Mid(ResI, kC, ik)                 
                    If kR <> kC Then
                        ResK = ResKr & ResKc 'Xử lý Kết hợp để ra ResK từ ResKr và ResKc
                        If ResT = ResK Then
                            iCount = iCount + 1
                        Else
                            iCount = iCount
                        End If
                        If iCount >= iDem Then      'Thay đổi từ 1-2000
                            If ir <=irow-1 then                         
                                kk = kk + 1
                                kArr(iR, kk) =iCount    ''KẾT QUẢ CẦN HIỂN THỊ gán tạm cho dễ hiểu
                            Else
                                kArr(iR, kk) = ResK        ''KẾT QUẢ CẦN HIỂN THỊ gán tạm cho dễ hiểu
                            End if                             
                        Else
                            Exit For                     '' Next kC
                        End If
                    Else
                        Exit For                        '' Next kR Hoặc Được xử lý riêng BỎ ĐIỀU KIỆN KR <>KC . Tuỳ theo  'KẾT QUẢ CẦN HIỂN THỊ NHỮNG GÌ
                    End If
                Next kC
            Next kR
    Next iC
Next iR

 

[strongman4789]

Xin hỗ trợ cách copy dữ liệu có điều kiện từ 1 mảng sang 1 mảng khác trong VBA
Tôi dùng VBA trong excel và cần xử lý copy dữ liệu từ 1 mảng 2 chiều (ví dụ dữ liệu quá trình công tác của các nhân sự) với 1 điều kiện (ví dụ quá trình công tác của 1 nhân sự cóa mã nhân sự là NS0001) sang 1 mảng khác. Tôi không muốn dùng vòng lặp kiểm tra (ví dụ như For … Next) vì sẽ mất nhiều thời gian. ACE có cách nào nỗ trợ mình nhé.
Thanks các bác

 

[Hoàng Tuấn 868]

Xin hỗ trợ cách copy dữ liệu có điều kiện từ 1 mảng sang 1 mảng khác trong VBA
Tôi dùng VBA trong excel và cần xử lý copy dữ liệu từ 1 mảng 2 chiều (ví dụ dữ liệu quá trình công tác của các nhân sự) với 1 điều kiện (ví dụ quá trình công tác của 1 nhân sự cóa mã nhân sự là NS0001) sang 1 mảng khác. Tôi không muốn dùng vòng lặp kiểm tra (ví dụ như For … Next) vì sẽ mất nhiều thời gian. ACE có cách nào nỗ trợ mình nhé.
Thanks các bác

Làm nhân sự mà chính tả thế này thì căng đây.

 

[Maika8008]

Xin hỗ trợ cách copy dữ liệu có điều kiện từ 1 mảng sang 1 mảng khác trong VBA
Tôi dùng VBA trong excel và cần xử lý copy dữ liệu từ 1 mảng 2 chiều (ví dụ dữ liệu quá trình công tác của các nhân sự) với 1 điều kiện (ví dụ quá trình công tác của 1 nhân sự cóa mã nhân sự là NS0001) sang 1 mảng khác. Tôi không muốn dùng vòng lặp kiểm tra (ví dụ như For … Next) vì sẽ mất nhiều thời gian. ACE có cách nào nỗ trợ mình nhé.
Thanks các bác

Không duyệt qua từng dòng của mảng nguồn thì biết gì mà copy?

 

[ptm0412]

Làm nhân sự mà chính tả thế này thì căng đây.

Không có lỗi chính tả. Một lỗi đánh máy nhanh và vài chữ viết tắt. Bắt lỗi thì phải bắt cho đúng.

 

[VetMini]

Không có lỗi chính tả. Một lỗi đánh máy nhanh và vài chữ viết tắt. Bắt lỗi thì phải bắt cho đúng.

2 lỗi đánh nhanh chứ không phải 1.

@chủ bài #1473:
1. sao biết For...Next sẽ lâu?
2. chỉ cần lọc một mã sang sheet khác thì dùng Advanced Filter. Ở diễn đàn này có cả đống. Chỉ là về sau có mấy người khoái Đít sần cho nên cứ thấy từ "lọc, tổng" là tương đít sần vào. Muốn tìm các giải thuật khác thì chịu khó mò mấy bài cũ. Không có kiên nhẫn mò thì Record Macro.
3. muốn tôi chỉ gì thêm nữa thì sửa mấy từ tiếng Anh đi. Tôi không thích moa toa luỹ ẻn.

 

[strongman4789]

2 lỗi đánh nhanh chứ không phải 1.

@chủ bài #1473:
1. sao biết For...Next sẽ lâu?
2. chỉ cần lọc một mã sang sheet khác thì dùng Advanced Filter. Ở diễn đàn này có cả đống. Chỉ là về sau có mấy người khoái Đít sần cho nên cứ thấy từ "lọc, tổng" là tương đít sần vào. Muốn tìm các giải thuật khác thì chịu khó mò mấy bài cũ. Không có kiên nhẫn mò thì Record Macro.
3. muốn tôi chỉ gì thêm nữa thì sửa mấy từ tiếng Anh đi. Tôi không thích moa toa luỹ ẻn.

Thanks bạn đã góp ý DẤT xây dựng, nhưng mình không muốn dùng filter trên sheet (và chưa có cách nào dùng được để giải quyết bài toán của mình).
Bài toán của mình ở đây là tính lãi chậm thanh toán bán hàng sản phẩm là căn hộ.
Dữ liệu đầu vào nằm trong 3 sheet, cụ thể như sau:
- Sheet 1: Lưu danh sách các căn hộ (mã căn hộ, các thông số căn hộ, số tiền bán, ngày bán)
- Sheet 2: Lưu tiến độ yêu cầu thanh toán của tất cả các căn hộ ((1) mã căn hộ, (2) ngày cần thanh toán, (3) số tiền cần thanh toán) (mỗi căn hộ có số lần yêu cầu thanh toán khác nhau nên bảng dữ liệu này chỉ gồm 3 cột)
- Sheet 3: Lưu dữ liệu thanh toán thực tế của tất cả các khách hàng ((1) mã căn hộ, (2) ngày thanh toán, (3) số tiền thanh toán), (mỗi căn hộ có số lần thanh toán khác nhau nên bảng dữ liệu này chỉ gồm 3 cột)

Mình đã viết code để xử lý theo kiểu For ... Next và đã xử lý được, cách xử lý như sau:
Để tính lãi chậm trả cho 1 mã sản phẩm
- Gán dữ liệu sheet 2 vào mảng (AR-1)
- Gán dữ liệu sheet 3 vào mảng (AR-2)
For (1) Quét các dữ liệu trong AR-1 (để lấy từng yêu cầu thanh toán của căn hộ cần tính) (dữ liệu cần quét hàng nghìn dòng)
For (2) Quét các dữ liệu trong AR-2 (để lấy từng đợt thanh toán thực tế của căn hộ cần tính) (dữ liệu cần quét hàng nghìn dòng)
Xử lý tính toán lãi chậm trả nếu thanh toán chậm so với yêu cầu
Next 2
Next 1
Cụ thể code mình đã viết ở đây:
https://www.giaiphapexcel.com/diendan/threads/hỗ-trợ-code-vba-tính-lãi-chậm-thanh-toán.157791/
Cách làm của mình đã giải quyết được nhưng mình thấy nó hơi chậm nên muốn nhờ ACE giúp đỡ xem có nhanh hơn được không.

Ở đây mình thấy có thể nhanh hơn nếu có cách copy các dữ liệu thỏa mãn điều kiện từ 1 mảng sang 1 mảng khác mà không phải duyệt từng dữ liệu, cụ thể như sau:
- Gán dữ liệu sheet 2 vào mảng (AR-1)
- Gán dữ liệu sheet 3 vào mảng (AR-2)
- Copy dữ liệu mảng AR-1 chỉ của mã căn hộ cẩn tính sang mảng AR1.1
- Copy dữ liệu mảng AR-2 chỉ của mã căn hộ cẩn tính sang mảng AR2.1
For (1) Quét các dữ liệu trong AR-1.1 (để lấy từng yêu cầu thanh toán) (khoảng 5 hàng)
For (2) Quét các dữ liệu trong AR-2.1 (để lấy từng đợt thanh toán thực tế) (khoảng 10 hàng)
Xử lý tính toán lãi chậm trả nếu thanh toán chậm so với yêu cầu
Next 2
Next 1

Sorry vì mình không đưa ra bài toán tổng thể ban đầu mà chỉ đề nghị hỗ trợ 1 việc cụ thể (là copy các dữ liệu thỏa mãn 1 điều kiện cụ thể sang 1 mảng khác mà không cần duyệt từng dữ liệu).
(Mình đã để ý đánh máy cẩn thận, nếu có gõ nhầm ACE thông cảm nhé)
Thanks các bác