Copy dữ liệu trong 1 sheet dùng VBA (1 người xem)

[NQ_AT]

Thân chào các bạn,
Mình mới mày mò VBA và viết ra code để copy dữ liệu trong 1 sheet, với sheet 1, khi Range là 1 cột thì dùng offset chạy ok, nhưng qua sheet 2, khi tập hợp 2 Range thì ko biết set IF thế nào luôn, nó cứ chạy ào ào.

Mục đích là copy dữ liệu từ bảng 1 sang bảng 2 theo điều kiện:

- Nếu tại cột E những dòng nào có giá trị thì mới copy qua >>> cái này chưa giới hạn được

- Tại bảng 2, những ô nào highlight màu đỏ thì bỏ qua không cần copy đè lên. >> cái này ok rồi.

Nhờ các bạn xem giúp file và hướng dẫn giúp mình cách khắc phục nha.

Cảm ơn rất nhiều.

 

[NQ_AT]

Mình đã làm được phần này rồi. Code ra thế này

Sub copydulieusheet2()

Dim Rng As Range, Cll As Range, SRng As Range, k As Integer


With Sheets("Sheet2")
    
    Set Rng = Application.Union(.Range(.[P5], .[R65000].End(xlUp)), .Range(.[T5], .[V65000].End(xlUp)))
    
   For Each Cll In Rng
   
    k = Cll.Column - 5
     If Cll.Offset(, -k).Value <> "" Then
        If Cll.Offset(, -10).Font.Color <> vbRed Then
            
                Cll.Offset(, -10).Value = Cll.Value
                
        End If
       
       End If
  
    Next
End With


End Sub

Nhưng các bạn cho mình hỏi chút, mình muốn nó chạy tự động luôn

Bên bảng 1, nếu các dòng nào thay đổi giá trị thì nó sẽ tự động cập nhật qua bảng 2 theo dòng tương ứng luôn. ( nhưng vẫn theo điều kiện như hiện tại)

Các bạn hướng dẫn giúp mình code như thế nào nha.

Cảm ơn các bạn rất nhiều.

 

[NQ_AT]

Sau khi mày mò ra được cái này nhưng mà thấy nó chạy chậm quá, vì mỗi lần thay đổi nó copy cả bảng tính. Mong các bạn xem giúp mình với nha. kiểu này mà dữ liệu 5000 dòng thì thua.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cll As Range, SRng As Range, k As Integer
Application.ScreenUpdating = False
With ActiveSheet
        Set Rng = Application.Union(.Range(.[P5], .[R65000].End(xlUp)), .Range(.[T5], .[V65000].End(xlUp))) 
  If Not Intersect(Target, Rng) Is Nothing Then
   For Each Cll In Rng 
      k = Cll.Column - 5 
    If Cll.Offset(, -k).Value <> "" Then  
      If Cll.Offset(, -10).Font.Color <> vbRed Then                          
  Cll.Offset(, -10).Value = Cll.Value                       
 End If           
 End If     
 Next    
End If
End With
Application.ScreenUpdating = True
End Sub

 

[Let'GâuGâu]

Sau khi mày mò ra được cái này nhưng mà thấy nó chạy chậm quá, vì mỗi lần thay đổi nó copy cả bảng tính. Mong các bạn xem giúp mình với nha. kiểu này mà dữ liệu 5000 dòng thì thua.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cll As Range, SRng As Range, k As Integer
'Application.ScreenUpdating = False
.................................
'Application.ScreenUpdating = True
End Sub

bỏ 2 chú này đi nó chạy nhanh à
khi sử dụng worksheet change hay selection change thì nó phản tác dụng

 

[NQ_AT]

bỏ 2 chú này đi nó chạy nhanh à
khi sử dụng worksheet change hay selection change thì nó phản tác dụng

Đúng là đã chạy nhanh, cảm ơn bạn Let'GâuGâu nha, cái tên ấn tượng quá.
Code của mình có cần chỉnh chổ nào không vậy bạn? Không biết khi 5000 dòng thì thế nào.

 

[Let'GâuGâu]

Đúng là đã chạy nhanh, cảm ơn bạn Let'GâuGâu nha, cái tên ấn tượng quá.
Code của mình có cần chỉnh chổ nào không vậy bạn? Không biết khi 5000 dòng thì thế nào.

tại tui đặt là let'go, nhưng mà trùng tên ghét quá đặt dzậy cho nó hỏng đụng hàng
thử code này xe

Sub copydulieusheet1()

Dim ng As Variant, i, j, k As Long
ng = [p5].Resize([p60000].End(3).Row, 7).Value
For i = 6 To 12
    For j = 5 To [f6000].End(3).Row
        If Cells(j, i).Font.Color = vbRed Then ng(j - 4, i - 5) = Cells(j, i)
    Next
Next
[f5].Resize(j - 4, 7).Value = ng
End Sub

 

[NQ_AT]

tại tui đặt là let'go, nhưng mà trùng tên ghét quá đặt dzậy cho nó hỏng đụng hàng
thử code này xe

Sub copydulieusheet1()

Dim ng As Variant, i, j, k As Long
ng = [p5].Resize([p60000].End(3).Row, 7).Value
For i = 6 To 12
    For j = 5 To [f6000].End(3).Row
        If Cells(j, i).Font.Color = vbRed Then ng(j - 4, i - 5) = Cells(j, i)
    Next
Next
[f5].Resize(j - 4, 7).Value = ng
End Sub

Code này không ổn bạn Let'GâuGâu ơi, nó chạy còn chậm hơn code trước nữa, khi Cột E hoặc cell trong bảng 2 thay đổi nó đều kiểm tra và copy lại.

Ý Mình là khi giá trị bảng 1 thay đổi thì nó mới copy giá trị mới qua bảng 2 (Còn bảng 2 có thay đổi gì kệ nó), và nó có 2 Range nha bạn, Cột I bên bảng 2 mình tự nhập tay., giá trị, do đó mình mới chia ra làm 2 Range.

Nhờ bạn Let'GâuGâu xem giúp mình nha. Cảm ơn bạn rất nhiều.

Nếu nó chỉ copy những chổ nào thay đổi thì tốt quá.

 

[Let'GâuGâu]

Code này không ổn bạn Let'GâuGâu ơi, nó chạy còn chậm hơn code trước nữa, khi Cột E hoặc cell trong bảng 2 thay đổi nó đều kiểm tra và copy lại.

Ý Mình là khi giá trị bảng 1 thay đổi thì nó mới copy giá trị mới qua bảng 2 (Còn bảng 2 có thay đổi gì kệ nó), và nó có 2 Range nha bạn, Cột I bên bảng 2 mình tự nhập tay., giá trị, do đó mình mới chia ra làm 2 Range.

Nhờ bạn Let'GâuGâu xem giúp mình nha. Cảm ơn bạn rất nhiều.

Nếu nó chỉ copy những chổ nào thay đổi thì tốt quá.

code tôi viết ko chạy trên sự kiện, làm một cái buttom, khi nào muốn chạy thì nhấn vào.
bên bảng 2, mấy cái cell rổng, thực tế thì nó có chứa cái gì ko, hay nó là cell rổng?
============
còn bạn muốn khi nào sửa cell nào bên bảng 1 thì nó sửa bên bảng 2 thì chỉ việc offfset là được
chẳng hạn bạn thay đổi cell P5 (bảng 2) thì
với sự kiện worksheet change

if target.offset(,-10).font.color<>vbred then .value=target.value

chứ cần chi phải copy hết toàn bộ cả cái bảng?

 

[NQ_AT]

code tôi viết ko chạy trên sự kiện, làm một cái buttom, khi nào muốn chạy thì nhấn vào.
bên bảng 2, mấy cái cell rổng, thực tế thì nó có chứa cái gì ko, hay nó là cell rổng?
============
còn bạn muốn khi nào sửa cell nào bên bảng 1 thì nó sửa bên bảng 2 thì chỉ việc offfset là được
chẳng hạn bạn thay đổi cell P5 (bảng 2) thì
với sự kiện worksheet change

if target.offset(,-10).font.color<>vbred then .value=target.value

chứ cần chi phải copy hết toàn bộ cả cái bảng?

Cảm ơn bạn Let'GâuGâu rất nhiều, mình nếu như khai báo kiểu đó thì mình sẽ có 6 dòng lệnh tương ứng cho 6 cột đúng ko bạn. Lúc đó nó chỉ xét trên cột thì sẽ nhẹ hơn trên 6 cột.

Những Cell rỗng đó không cố định, tùy lúc mình nhập thôi, Nhưng cứ theo nguyên tắc là copy dữ liệu từ bảng 1 >> bảng 2 theo điều kiện..
Để mình thử code của bạn xem sao.

 

[Quang_Hải]

Nhiều khi chủ thớt chỉ muốn có vầy. Thử coi không đúng thì thôi nhé
Nếu mà đúng ý thì bảo đảm 100 000 dòng chỉ chạy trong cái nháy mắt

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [F5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
   For j = 1 To UBound(arr1, 2)
      If arr1(i, j) = "" Then
         arr1(i, j) = Arr2(i, j)
      End If
   Next
Next
[F5:L24].Value = arr1
End Sub

 

[NQ_AT]

Nhiều khi chủ thớt chỉ muốn có vầy. Thử coi không đúng thì thôi nhé
Nếu mà đúng ý thì bảo đảm 100 000 dòng chỉ chạy trong cái nháy mắt

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [F5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
   For j = 1 To UBound(arr1, 2)
      If arr1(i, j) = "" Then
         arr1(i, j) = Arr2(i, j)
      End If
   Next
Next
[F5:L24].Value = arr1
End Sub

Cảm ơn rất nhiều sự giúp đỡ của các bạn, Nhưng code của bạn quanghai1969 chưa đúng, bạn xem mình giải thích lại bên dưới nha.


Mình xin giải thích lại quá trình copy 2 cái bảng như sau:

Column [P:R] (bảng 1) >>> Copy >>> Column [F:H] (bảng 2)
Column [T:V] (bảng 1) >>> Copy >>> Column [J:L] (bảng 2)

>> Trong 1 bảng sẽ có 2 Range. Copy thì theo điều kiện sau:

- Tại Cột E: Value <> "" thì thực hiện copy dòng tương ứng, còn hàng nào mà bên cột E không có giá trị thì bỏ qua.
- Tại các cột [F:H] ,[J:L] nếu ô nào highlight màu đỏ thì bỏ qua ko cần copy giá trị vào đó.
- Khi giá trị trong các cột ở bảng 1 thay đổi thì copy lại qua bảng 2.
Sau khi mình làm theo lời bạn Let'GâuGâu thì có code sau:

.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cll As Range, SRng As Range, k As Integer
With ActiveSheetSet Rng = Application.Union(.Range(.[P5], .[R65000].End(xlUp)), .Range(.[T5], .[V65000].End(xlUp)))
  If Not Intersect(Target, Rng) Is Nothing Then         
k = Target.Column - 5 '<<<< Tại sao dòng này bị báo lỗi copy giá trị mới vào bảng 1    
If Target.Offset(, -k).Value <> "" Then        
If Target.Offset(, -10).Font.Color <> vbRed Then        
Target.Offset(, -10).Value = Target.Value        
End If    
End If   
End If
End With
End Sub

Khi mình thêm giá trí vào bảng 1 thì nó báo lỗi ngay ( lỗi Type Missmatch), để bình thường thì chạy ok. Nếu bỏ dòng lỗi chổ K đi thì code chạy nhanh như tia chớp (thực hiện copy 4500 dòng), nhưng lúc đó không còn điều kiện cho cột E nữa.

Ghi Chú: Hình như code này mình phải tác động trực tiếp vào vùng Target thì nó mới thực thi, nếu vùng Target mà link giá trị từ nơi khác thì Target có thay đổi giá trị nó vẫn không chạy cập nhật lại. Xin các bạn cho hướng giải quyết với nha.

 

[Quang_Hải]

Cảm ơn rất nhiều sự giúp đỡ của các bạn, Nhưng code của bạn quanghai1969 chưa đúng, bạn

Lại đoán tiếp.
Hay là bạn muốn thế này.

Lưu ý thêm nếu code chạy đúng thì khi chỉnh sửa vùng dữ liệu thì dòng bắt đầu và dòng kết thúc của 2 vùng phải song song nhé. Hy vọng trúng. Hỏng trúng nữa thì chạy... tét.

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
   For j = 1 To UBound(Arr2, 2)
        If arr1(i, 1) <> "" Then
            If arr1(i, j + 1) = "" Then
                arr1(i, j + 1) = Arr2(i, j)
            End If
        Else
            If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                arr1(i, j + 1) = Arr2(i, j)
            End If
        End If
   Next
Next
[E5:L24].Value = arr1
End Sub

 

[NQ_AT]

Lại đoán tiếp.
Hay là bạn muốn thế này.

Lưu ý thêm nếu code chạy đúng thì khi chỉnh sửa vùng dữ liệu thì dòng bắt đầu và dòng kết thúc của 2 vùng phải song song nhé. Hy vọng trúng. Hỏng trúng nữa thì chạy... tét.

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
   For j = 1 To UBound(Arr2, 2)
        If arr1(i, 1) <> "" Then
            If arr1(i, j + 1) = "" Then
                arr1(i, j + 1) = Arr2(i, j)
            End If
        Else
            If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                arr1(i, j + 1) = Arr2(i, j)
            End If
        End If
   Next
Next
[E5:L24].Value = arr1
End Sub

Xin phép tác giả quanghai1969, Mình chỉnh lại code của bạn chút xíu để đúng ý mình, vì code của bạn nếu bên bảng 2 đã có giá trị rồi thì nó không copy lên được nữa.

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)   
    For j = 1 To UBound(Arr2, 2)        
      If arr1(i, 1) <> "" Then            
         If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then               
            arr1(i, j + 1) = Arr2(i, j)                        
         End If        
     End If   
   Next
Next
[E5:L24].Value = arr1
End Sub

Chạy ok rồi, nhưng làm sao để bỏ cột ra đây bạn, vì mình muốn tự nhập dữ liệu vào cột , mà nó cứ copy giá trị cột đè lên.

 

[Quang_Hải]

Xin phép tác giả quanghai1969, Mình chỉnh lại code của bạn chút xíu để đúng ý mình, vì code của bạn nếu bên bảng 2 đã có giá trị rồi thì nó không copy lên được nữa.

Chạy ok rồi, nhưng làm sao để bỏ cột ra đây bạn, vì mình muốn tự nhập dữ liệu vào cột , mà nó cứ copy giá trị cột đè lên.

Do bạn cung cấp dữ liệu không rõ ràng nên mới kéo dài.
..........
Nếu muốn cột I không bị đè thì thêm 1 cặp If ... End If nữa. Xét nếu J <> 4 thì chạy tiếp.

 

[NQ_AT]

Do bạn cung cấp dữ liệu không rõ ràng nên mới kéo dài.
..........
Nếu muốn cột I không bị đè thì thêm 1 cặp If ... End If nữa. Xét nếu J <> 4 thì chạy tiếp.

Vì mình mới ngâm cứu VBA nên nhiều cái còn thiếu sót, mong bạn thông cảm nha.
Thật ra code của bạn cao siêu quá, mình chưa thể hiểu hết được,
Cái chổ vẫn chưa hiểu (Arr2, 2) và Cells(i + 4, j + 5)

Nhưng bạn đã cho đáp áp được là ok rồi, bắt tay mò mò vậy.

Cảm ơn bạn nhiều nha, xong phần này đến phần worksheet change chắc phải nhờ bạn giúp nữa vậy.

Bạn cho mình hỏi giá trị trong bảng 1 là mình link từ nới khác, chứ không phải mình tác động vào thì code này có chạy được trong worksheet_change?

 

[Quang_Hải]

Vì mình mới ngâm cứu VBA nên nhiều cái còn thiếu sót, mong bạn thông cảm nha.
Thật ra code của bạn cao siêu quá, mình chưa thể hiểu hết được,
Cái chổ vẫn chưa hiểu (Arr2, 2) và Cells(i + 4, j + 5)

Nhưng bạn đã cho đáp áp được là ok rồi, bắt tay mò mò vậy.

Cảm ơn bạn nhiều nha, xong phần này đến phần worksheet change chắc phải nhờ bạn giúp nữa vậy.

Bạn cho mình hỏi giá trị trong bảng 1 là mình link từ nới khác, chứ không phải mình tác động vào thì code này có chạy được trong worksheet_change?

Cách mình viết là để tăng tốc code lên đến mức có thể, hạn chế đụng tới sheet.
Bạn sửa code như vậy sẽ giảm tốc độ đáng kể.

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
        If j <> 4 Then
            If arr1(i, 1) <> "" Then
                If arr1(i, j + 1) <> "" Then
                    If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                        arr1(i, j + 1) = Arr2(i, j)
                    End If
                Else
                    arr1(i, j + 1) = Arr2(i, j)
                End If
            End If
        End If
   Next
Next
[E5:L24].Value = arr1
End Sub

 

[NQ_AT]

Cách mình viết là để tăng tốc code lên đến mức có thể, hạn chế đụng tới sheet.
Bạn sửa code như vậy sẽ giảm tốc độ đáng kể.

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
        If j <> 4 Then
            If arr1(i, 1) <> "" Then
                If arr1(i, j + 1) <> "" Then
                    If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                        arr1(i, j + 1) = Arr2(i, j)
                    End If
                Else
                    arr1(i, j + 1) = Arr2(i, j)
                End If
            End If
        End If
   Next
Next
[E5:L24].Value = arr1
End Sub

Cảm ơn bạn quanghai1969 rất nhiều,Code chạy ok rồi, nhưng do mình mới thiết kết lại form nên nó tăng thêm mỗi bảng 2 cột. Mình sẽ cố gắng làm lại code của bạn ( Mặc dù khó hiểu quá. hjhj) vì nhờ bạn viết lại rất ngại và mình cũng hok giỏi lên được, Khi nào bí quá mong bạn hướng dẫn lại giúp mình nha.
Một lần nữa cảm ơn các bạn rất nhiều, chúc nhiều sức khỏe.

 

[NQ_AT]

Xin chào bạn quanghai1969, Mình xin dịch code của bạn xem đúng không nha, nếu có sai sót nhờ bạn bổ sung giúp, vì mình đang chỉnh Form lại, mà về mảng mới biết sơ sơ. hjhj

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
        If j <> 4 Then
            If arr1(i, 1) <> "" Then
                If arr1(i, j + 1) <> "" Then
                    If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                        arr1(i, j + 1) = Arr2(i, j)
                    End If
                Else
                    arr1(i, j + 1) = Arr2(i, j)
                End If
            End If
        End If
   Next
Next
[E5:L24].Value = arr1
End Sub

D1: khai báo mảng Arr1, 2 và 2 biền i,j
D2: đặt Arr1 = các giá trị trong [E5:L24] >> bảng 2
D3: đặt Arr2 = các giá trị trong [P5:V24] >> bảng 1
D4: Cho i chạy từ dòng 1 đến hết các dòng của [E5:[L24]
D5: Cho j chạy từ cột 1 đến hết các cột của [P5:V24]
D6: Nếu j khác cột thứ 4 thì tiếp D7
D7: Nếu các dòng trong cột đầu tiên mảng Arr1 khác "" thì tiếp D8
D8: Nếu các dòng bắt đầu từ cột 2 trong mảng Arr1 khác "" thì tiếp D9, ngược lại thì chạy qua D13: Hiện tại rỗng hay ko nó đều copy vào mà, dòng này mình chưa hiểu tác dụng lắm.
D9: Tại các ô bắt đầu từ dòng 5, cột 6 (F5- Nói chung là các ô trong bảng 2 chạy theo i và j) khác màu đỏ thì tiếp D10
>>> vì ở đây 2 bảng giống nhau về số cột và dòng nên mình mới dùng j chung cho Arr1, đúng không bạn?
D10: Copy giá trị từ bảng 1 vào bảng 2 tương ứng với i và j, bắt đầu từ cột thứ 2
D11: Kết thúc copy với điều kiện
D13: Copy giá trị từ bảng 1 vào bảng 2 tương ứng với i và j, bắt đầu từ cột thứ 2 : Vì sao phải thêm dòng này và dòng D8? Đây là chủ ý của bạn làm cho code nhanh hơn hay là làm cho code thêm chặc chẽ?
D14 -D18: kết thúc các câu lệnh
D19:

[E5:L24].Value = arr1

: Tại sao lại đặt giá trị lại cho Arr1 vậy bạn?

 

[Quang_Hải]

Xin chào bạn quanghai1969, Mình xin dịch code của bạn xem đúng không nha, nếu có sai sót nhờ bạn bổ sung giúp, vì mình đang chỉnh Form lại, mà về mảng mới biết sơ sơ. hjhj

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
        If j <> 4 Then
            If arr1(i, 1) <> "" Then
                If arr1(i, j + 1) <> "" Then
                'dòng này sẽ làm code rùa vì kiểm tra trên bảng tính
                'nhưng buộc phải kiểm tra vì hết cách
                'nhưng vẫn copy trên bộ nhớ để tăng tốc. Đây là 1 kỹ năng khi viết code
                    If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                        arr1(i, j + 1) = Arr2(i, j)
                    End If
                Else
                    'dòng này giúp code nhanh hơn vì copy trên bộ nhớ
                    arr1(i, j + 1) = Arr2(i, j) 
                End If
            End If
        End If
   Next
Next
'dòng này là gán giá trị tính toán xuống sheet.
[E5:L24].Value = arr1
End Sub

 

[NQ_AT]

Sub DoanMo()
Dim arr1(), Arr2(), i, j
arr1 = [E5:L24].Value
Arr2 = [P5:V24].Value
For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
        If j <> 4 Then
            If arr1(i, 1) <> "" Then
                If arr1(i, j + 1) <> "" Then
                'dòng này sẽ làm code rùa vì kiểm tra trên bảng tính
                'nhưng buộc phải kiểm tra vì hết cách
                'nhưng vẫn copy trên bộ nhớ để tăng tốc. Đây là 1 kỹ năng khi viết code
                    If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                        arr1(i, j + 1) = Arr2(i, j)
                    End If
                Else
                    'dòng này giúp code nhanh hơn vì copy trên bộ nhớ
                    arr1(i, j + 1) = Arr2(i, j) 
                End If
            End If
        End If
   Next
Next
'dòng này là gán giá trị tính toán xuống sheet.
[E5:L24].Value = arr1
End Sub

Xin chào anh quanghai1969, và các anh GPE ( bữa giờ gọi bạn cũng hơi kì kì vì mình là người mới trên này)

Mong các anh hướng dẫn giúp chút xíu để mình tự phát triển code này.
1- trong code có đoạn

For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
       If j <> 4 Then
      .
      .
      .

Vậy nếu mình muốn J khác cột 4 đến 6 thì phải khai báo thế nào?
2- Đụng tới phần tính toán trong mảng, mà tìm hoài chưa thấy tài liệu hướng dẫn, đây là trường hợp ngược lại của J (nếu J = cột 4 To 6 của Arr2)

Else
If arr1(i,4) <> "" Then ' Cột số 4 của Arr1 là cột số lượng
     arr1(i,5).value = Arr2(i,5).value * arr1(i,4).value
     arr1(i,6).value = Arr2(i,6).value * arr1(i,4).value
End If

nó báo lỗi, hình như cái này đang là mảng nên mình ko cho value được, mà hiện tại ko biết làm thế nào, mong các anh tiếp sức.