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.

 

[Quang_Hải]

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.

Viết thế này If J = 4 or J = 5 or J =6 Then
Hoặc If J <> 4 or J <> 5 or J <> 6 Then
Thử sẽ biết nên chọn cái nào
.......................
Mảng không được có cái đuôi mọc ra phía sau vậy đâu. Bạn phải làm giống mọi người chứ.

 

[NQ_AT]

Viết thế này If J = 4 or J = 5 or J =6 Then
Hoặc If J <> 4 or J <> 5 or J <> 6 Then
Thử sẽ biết nên chọn cái nào
.......................
Mảng không được có cái đuôi mọc ra phía sau vậy đâu. Bạn phải làm giống mọi người chứ.

Cảm ơn anh , vấn đề nằm ở chổ chưa có kiến thức VBA nên có ý tưởng mà ko biết dùng lệnh gì, biết mảng ko thể mọc đuôi nhưng bí quá gắn thêm đuôi cho nó thử thế nào. hjhjjh.
vừa bắt gặp bài này của anh, thấy nó cũng dùng mảng và cái Res gì đó, để ngâm cứu thử xem, thấy có dùng value trong mảng

Sub loc()
Dim Data(), Res(), i, j, k
[A13:H5000].ClearContents
Data = Sheet1.Range(Sheet1.[AB9], Sheet1.[AB65536].End(3)).Resize(, 10).Value
ReDim Res(1 To UBound(Data), 1 To 8)
For i = 1 To UBound(Data)
   If Data(i, 1) >= [D5].Value Then
      If Data(i, 1) <= [D6].Value Then
         If [H7].Value = "" Then
            If Data(i, 9) = [H6].Value Or Data(i, 8) = [H6].Value Then
               k = k + 1
               Res(k, 1) = Data(i, 1)
               Res(k, 2) = Data(i, 2)
               Res(k, 3) = Data(i, 3)
               Res(k, 4) = Data(i, 5)
               Res(k, 5) = Data(i, 7)
               If Data(i, 8) = [H6].Value Then Res(k, 6) = Data(i, 9)
               If Data(i, 9) = [H6].Value Then Res(k, 6) = Data(i, 8)
               If Data(i, 8) = [H6].Value Then Res(k, 7) = Data(i, 10)
               If Data(i, 9) = [H6].Value Then Res(k, 8) = Data(i, 10)
            End If
         Else
            If Data(i, 6) = [H7].Value Then
                If Data(i, 9) = [H6].Value Or Data(i, 8) = [H6].Value Then
                  k = k + 1
                  Res(k, 1) = Data(i, 1)
                  Res(k, 2) = Data(i, 2)
                  Res(k, 3) = Data(i, 3)
                  Res(k, 4) = Data(i, 5)
                  Res(k, 5) = Data(i, 7)
                  If Data(i, 8) = [H6].Value Then Res(k, 6) = Data(i, 9)
                  If Data(i, 9) = [H6].Value Then Res(k, 6) = Data(i, 8)
                  If Data(i, 8) = [H6].Value Then Res(k, 7) = Data(i, 10)
                  If Data(i, 9) = [H6].Value Then Res(k, 8) = Data(i, 10)
               End If
            End If
         End If
      End If
   End If
Next
k = k + 1
Res(k, 7) = "=sum(R13C:R[-1]C)"
Res(k, 8) = "=sum(R13C:R[-1]C)"
[A13].Resize(k, 8) = Res
End Sub

 

[VetMini]

... thấy nó cũng dùng mảng và cái Res gì đó, để ngâm cứu thử xem, thấy có dùng value trong mảng
...

Code trên được viết theo tinh thần VBScript, tức là lúc khai báo thì mọi biến đều thuộc dạng Variant. Bao giờ được gán trị thì biến mới biết dạng thực của nó.

Cái mà mấy bạn gọi là "cái đuôi", theo đúng từ ngữ lập trình thì nó là thành phần của lớp (class member). Thành phần của lớp được chia ra làm hai loại là hàm/phương thức và thuộc tính.

Chỉ có những loại dữ liệu dạng Object lấy từ một lớp phức tạp mới có thành phần. Khi khai báo định nghĩa một lớp phức tạp, người thiết kế cũng đồng thời định nghĩa các thành phần. Các loại dữ liệu như Integer, Long, Float, Double, String, ... là loại dữ liệu căn bản của ngôn ngữ VBA. Những loại này không phải là phức tạp nên không có thành phần. Loại dữ liệu như WorkSheet, Range, ... là loại dữ liệu phức tạp cho nên chúng có thành phần. Và Value là thành phần dạng thuộc tính của Range.

Trong hầu hết các ngôn ngữ lập trình hướng đối tượng, dấu chấm là ký hiệu gọi thành phần của lớp. Vì vậy, nếu rangeGiDo là một range thì "rangeGiDo.Value" là biểu thức truy cứu thộc tính Value của rangeGiDo

Mảng chỉ là một dãy dữ liệu giống kiểu và xếp kế nhau. Chính mảng không phải là một lớp cho nên không có thành phần. Mặt khác, vì mảng là một dãy dữ liệu gồm nhiều phần tử cho nên hầu như tất cả các ngôn ngữ lập trình đều có một con toán truy cập phân tử mảng. Trong VBA, con toán này là dây ngoặc (). Nếu Arr là mảng thì biểu thức Arr(i) truy cập phần tử thứ i của Arr.

Câu hỏi cuối cúng của bạn: tại sao có mảng vẫn thấy có "cái đuôi"?
Mảng chỉ là một dãy phần tử. Mỗi phần tử của mảng vẫn có thể là ở dạng một lớp phức tạp. Trường hợp đó, chúng có quyền dùng "cái đuôi".

Tuy nhiên trong code mà bạn dẫn ra, các mảng tuy khai báo được mặc định phần tử dạng Variant nhưng sau khi gán trị thì chúng trở thành String. Dữ liệu dạng String không có thuộc tính Value.

Lưu ý: ngoài các tính chất phức tạp, Range cũng đồng thời bao gồm tất cả những tính chất của mảng, cho nên cũng có khi người ta gọi Range là mảng.

 

[NQ_AT]

Code trên được viết theo tinh thần VBScript, tức là lúc khai báo thì mọi biến đều thuộc dạng Variant. Bao giờ được gán trị thì biến mới biết dạng thực của nó.

Cái mà mấy bạn gọi là "cái đuôi", theo đúng từ ngữ lập trình thì nó là thành phần của lớp (class member). Thành phần của lớp được chia ra làm hai loại là hàm/phương thức và thuộc tính.

Chỉ có những loại dữ liệu dạng Object lấy từ một lớp phức tạp mới có thành phần. Khi khai báo định nghĩa một lớp phức tạp, người thiết kế cũng đồng thời định nghĩa các thành phần. Các loại dữ liệu như Integer, Long, Float, Double, String, ... là loại dữ liệu căn bản của ngôn ngữ VBA. Những loại này không phải là phức tạp nên không có thành phần. Loại dữ liệu như WorkSheet, Range, ... là loại dữ liệu phức tạp cho nên chúng có thành phần. Và Value là thành phần dạng thuộc tính của Range.

Trong hầu hết các ngôn ngữ lập trình hướng đối tượng, dấu chấm là ký hiệu gọi thành phần của lớp. Vì vậy, nếu rangeGiDo là một range thì "rangeGiDo.Value" là biểu thức truy cứu thộc tính Value của rangeGiDo

Mảng chỉ là một dãy dữ liệu giống kiểu và xếp kế nhau. Chính mảng không phải là một lớp cho nên không có thành phần. Mặt khác, vì mảng là một dãy dữ liệu gồm nhiều phần tử cho nên hầu như tất cả các ngôn ngữ lập trình đều có một con toán truy cập phân tử mảng. Trong VBA, con toán này là dây ngoặc (). Nếu Arr là mảng thì biểu thức Arr(i) truy cập phần tử thứ i của Arr.

Câu hỏi cuối cúng của bạn: tại sao có mảng vẫn thấy có "cái đuôi"?
Mảng chỉ là một dãy phần tử. Mỗi phần tử của mảng vẫn có thể là ở dạng một lớp phức tạp. Trường hợp đó, chúng có quyền dùng "cái đuôi".

Tuy nhiên trong code mà bạn dẫn ra, các mảng tuy khai báo được mặc định phần tử dạng Variant nhưng sau khi gán trị thì chúng trở thành String. Dữ liệu dạng String không có thuộc tính Value.

Lưu ý: ngoài các tính chất phức tạp, Range cũng đồng thời bao gồm tất cả những tính chất của mảng, cho nên cũng có khi người ta gọi Range là mảng.

Cảm ơn anh VetMini,

Đọc qua nhưng chưa đủ nội công để hiểu hết, hiểu được 60%. hjhjh
Nhưng anh có nói, dữ liệu kiểu String, vậy nếu mình dùng CDbl (String) để chuyển sang Number thì có dùng Vaue được hok?
Mong anh cho VD nào gần gần để mình hiểu thêm nha.

 

[VetMini]

Cảm ơn anh VetMini,
...
vậy nếu mình dùng CDbl (String) để chuyển sang Number thì có dùng Value được hok?

CDbl trả về dạng Double. Tôi đã có nói ở trên, Double là dạng đơn giản, làm gì có thuộc tính Value.

 

[NQ_AT]

Mong các anh xem giúp file, mình bó tay rồi, phần tính toán trong mảng ko biết tí gì, mà đưa về range cũng bị báo lỗi.

Hiện tại file này mình đã cho chạy ok 1 phần rồi, chỉ còn phần tính toán mình có nêu yêu cầu trong file.

Sub DoanMo()
Dim arr1(), Arr2(), i, j, k1, k2, Rng
arr1 = [E5:N24].Value
Arr2 = [Q5:Y24].Value
For i = 1 To UBound(arr1)
    For j = 1 To UBound(Arr2, 2)
                     If arr1(i, 1) <> "" Then               
                        'If arr1(i, k + 1) <> "" Then
                             If Cells(i + 4, j + 5).Font.ColorIndex <> 3 Then
                                   If j <> 5 And j <> 6 And j <> 7 And j <> 8 Then
                                       arr1(i, j + 1) = Arr2(i, j)
                                    Else 
                                            'phan nay botay      
              
                                  End If
                             End If
                      End If
           Next
   Next
[E5:N24].Value = arr1
End Sub

Mong các anh trợ giúp code còn lại để mình học hỏi thêm nha.

 

[VetMini]

Khả năng của bạn chưa đủ để đọc và hiểu code của người khác. Nhất là code của bạn quanghai1969 chuyên về tốc độ và sự ngắn gọn, bạn không nên chỉnh sửa code này vì chẳng những khó mà còn rất nguy hiểm.

Nếu muốn học code, bạn nên tìm những code chuyên về dễ hiểu và dễ chỉnh sửa. Loại code này ít sử dụng những thủ thuật chuyên về cải tiến tốc độ. Và nếu có những phần khó thì những phần này cũng được tách rời ra thảnh hàm/sub riêng biệt. Chủ yếu là bạn chỉ cần và chỉ nên sửa những chỗ dễ hiểu.

 

[NQ_AT]

Khả năng của bạn chưa đủ để đọc và hiểu code của người khác. Nhất là code của bạn quanghai1969 chuyên về tốc độ và sự ngắn gọn, bạn không nên chỉnh sửa code này vì chẳng những khó mà còn rất nguy hiểm.

Nếu muốn học code, bạn nên tìm những code chuyên về dễ hiểu và dễ chỉnh sửa. Loại code này ít sử dụng những thủ thuật chuyên về cải tiến tốc độ. Và nếu có những phần khó thì những phần này cũng được tách rời ra thảnh hàm/sub riêng biệt. Chủ yếu là bạn chỉ cần và chỉ nên sửa những chỗ dễ hiểu.

Vâng, mình đang cố gắng hết sức, Vậy trước mắt nhờ các anh làm giúp mình cho xong cái form này nha,vì form cần copy tới khoảng 5000 dòng nên code của anh quanghai1969 là rất tuyệt, vì tuần sau mình phải hoàn thiện form này rồi. Không phải mình lười mà vì trình độ chưa tới nên các anh thông cảm.

Nếu yêu cầu trong file chưa rõ thì các anh phản hồi lại để mình bổ sung liền nha.

Rất cảm ơn sự giúp đỡ nhiệt tình của các anh.

 

[Quang_Hải]

Vâng, mình đang cố gắng hết sức, Vậy trước mắt nhờ các anh làm giúp mình cho xong cái form này nha,vì form cần copy tới khoảng 5000 dòng nên code của anh quanghai1969 là rất tuyệt, vì tuần sau mình phải hoàn thiện form này rồi. Không phải mình lười mà vì trình độ chưa tới nên các anh thông cảm.

Nếu yêu cầu trong file chưa rõ thì các anh phản hồi lại để mình bổ sung liền nha.

Rất cảm ơn sự giúp đỡ nhiệt tình của các anh.

Mình không nghĩ là sẽ có ai đó lại đi ngồi dò từng ô rồi tô đỏ tô xanh, rồi lại chạy code.
Dữ liệu của bạn nhìn không thật nên không hứng thú nghiên cứu.

 

[Hau151978]

Vâng, mình đang cố gắng hết sức, Vậy trước mắt nhờ các anh làm giúp mình cho xong cái form này nha,vì form cần copy tới khoảng 5000 dòng nên code của anh quanghai1969 là rất tuyệt, vì tuần sau mình phải hoàn thiện form này rồi. Không phải mình lười mà vì trình độ chưa tới nên các anh thông cảm.

Nếu yêu cầu trong file chưa rõ thì các anh phản hồi lại để mình bổ sung liền nha.

Rất cảm ơn sự giúp đỡ nhiệt tình của các anh.

Mình tải thử file ở bài 26 thấy nhiều hình vẽ lằng nhằng khó hiểu quá. Bạn nên bỏ hết các hình vẽ đi, ghi rõ yêu cầu trong 1 sheet, có thể thêm kết quả cần làm trong sheet khác để dễ so sánh. Dữ liệu thì chỉ cần 10-20 dòng thôi.

 

[NQ_AT]

Mình không nghĩ là sẽ có ai đó lại đi ngồi dò từng ô rồi tô đỏ tô xanh, rồi lại chạy code.
Dữ liệu của bạn nhìn không thật nên không hứng thú nghiên cứu.

Cái này là đặt thù công việc bên mình đó anh.

Vì mình làm dự toán khối lượng, phải làm từng dòng, và trong các trường hợp khác nhau thì mình sẽ điều chỉnh giá( hoặc các thông tin về hàng hóa) khác nhau, khi điều chỉnh phải highlight màu đỏ lên, lúc đó giá ( hoặc các thông tin về hàng hóa) sẽ ko chạy theo data nữa. Đó là cách làm thực tế, mình muốn các anh giúp nên đâu có đưa form tào lao lên được, mong anh quanghai1969 hiểu cho.
Hiện tại mình chỉ còn vướng phần tính toán thôi, mong anh quanghai1969 xem xét giúp.

 

[NQ_AT]

Mình tải thử file ở bài 26 thấy nhiều hình vẽ lằng nhằng khó hiểu quá. Bạn nên bỏ hết các hình vẽ đi, ghi rõ yêu cầu trong 1 sheet, có thể thêm kết quả cần làm trong sheet khác để dễ so sánh. Dữ liệu thì chỉ cần 10-20 dòng thôi.

Cái dấu mũi tên mình chỉ từ bảng 1 sang bảng 2 phải ko anh? ý là mình muốn nói copy từ bảng 1 sang bảng 2( Anh chỉ cần xem ở Sheet 3 thôi)

OK, để mình làm cái kết quả trong sheet nữa rồi up lại nha.

 

[Quang_Hải]

Cái dấu mũi tên mình chỉ từ bảng 1 sang bảng 2 phải ko anh? ý là mình muốn nói copy từ bảng 1 sang bảng 2( Anh chỉ cần xem ở Sheet 3 thôi)

OK, để mình làm cái kết quả trong sheet nữa rồi up lại nha.

Bài này phải dùng chiêu khác, đó là Select Case.

If Arr1(i,1) <> "" Then
      For j = 2 To 10
         Select Case j
         Case 2, 3, 4, 5, 10
                 'xử lý như lúc đầu
         Case 6
               'xử lý cái mới chỗ này
         End Select
      Next
End If

 

[NQ_AT]

Bài này phải dùng chiêu khác, đó là Select Case.

      For j = 2 To 10
         Select Case j
         Case 2, 3, 4, 5, 10
                 'xử lý như lúc đầu
         Case 6
               'xử lý cái mới chỗ này
         End Select
      Next

Xin anh quanghai1969 giúp luôn code cho trót, hiện tại đang bị tẩu hỏa nhập ma sau khi lọt vào ma trận mảng.

Các điều kiện đưa ra là theo thực tế, anh quanghai1969 yên tâm nha.

 

[Quang_Hải]

Xin anh quanghai1969 giúp luôn code cho trót, hiện tại đang bị tẩu hỏa nhập ma sau khi lọt vào ma trận mảng.

Các điều kiện đưa ra là theo thực tế, anh quanghai1969 yên tâm nha.

Thử code này coi đúng ý không. Cũng thấy hơi mù mờ

Sub abc()
Dim Sarr(), Darr(), i, j, x, usd
Sarr = Range("Q5", [Y65536].End(3)).Value
Darr = Range("E5", [N65536].End(3)).Value
usd = [N2].Value
For i = 1 To UBound(Darr)
   If Darr(i, 1) <> "" Then
      For j = 2 To 10
         Select Case j
         Case 2, 3, 4, 5, 10
            If Darr(i, j) = "" Then
               Darr(i, j) = Sarr(i, j - 1)
            Else
               If Cells(i + 4, j + 4).Font.ColorIndex <> 3 Then
                  Darr(i, j) = Sarr(i, j - 1)
               End If
            End If
         Case 6
            If Darr(i, j) <> "" Then
               For x = 7 To 9
                  Darr(i, x) = Sarr(i, x - 1) * Darr(i, j) / usd
               Next
            End If
         End Select
      Next
   End If
Next
Range("E5", [N65536].End(3)).Value = Darr
End Sub

 

[NQ_AT]

Thử code này coi đúng ý không. Cũng thấy hơi mù mờ

Sub abc()
Dim Sarr(), Darr(), i, j, x, usd
Sarr = Range("Q5", [Y65536].End(3)).Value
Darr = Range("E5", [N65536].End(3)).Value
usd = [N2].Value
For i = 1 To UBound(Darr)
   If Darr(i, 1) <> "" Then
      For j = 2 To 10
         Select Case j
         Case 2, 3, 4, 5, 10
            If Darr(i, j) = "" Then
               Darr(i, j) = Sarr(i, j - 1)
            Else
               If Cells(i + 4, j + 4).Font.ColorIndex <> 3 Then
                  Darr(i, j) = Sarr(i, j - 1)
               End If
            End If
         Case 6
            If Darr(i, j) <> "" Then
               For x = 7 To 9
                  Darr(i, x) = Sarr(i, x - 1) * Darr(i, j) / usd
               Next
            End If
         End Select
      Next
   End If
Next
Range("E5", [N65536].End(3)).Value = Darr
End Sub

Tuyệt vời anh ơi, code chạy quá ok,
Nhưng sao nó chỉ chạy tới dòng 18 thôi anh? có bấm thế nào cũng ko thể chạy hơn dòng 18

 

[Quang_Hải]

Tuyệt vời anh ơi, code chạy quá ok,
Nhưng sao nó chỉ chạy tới dòng 18 thôi anh? có bấm thế nào cũng ko thể chạy hơn dòng 18

Thay đám rừng này vào thử coi

Sub abc()
Dim Sarr(), Darr(), i, j, x, usd
Sarr = Range("Q5", [Y65536].End(3)).Value
Darr = Range("E5", [Q65536].End(3).Offset(, -3)).Value
usd = [N2].Value
For i = 1 To UBound(Darr)
   If Darr(i, 1) <> "" Then
      For j = 2 To 10
         Select Case j
         Case 2, 3, 4, 5, 10
            If Darr(i, j) = "" Then
               Darr(i, j) = Sarr(i, j - 1)
            Else
               If Cells(i + 4, j + 4).Font.ColorIndex <> 3 Then
                  Darr(i, j) = Sarr(i, j - 1)
               End If
            End If
         Case 6
            If Darr(i, j) <> "" Then
               For x = 7 To 9
                  Darr(i, x) = Sarr(i, x - 1) * Darr(i, j) / usd
               Next
            End If
         End Select
      Next
   End If
Next
Range("E5", [Q65536].End(3).Offset(, -3)).Value = Darr
End Sub

 

[NQ_AT]

Thay đám rừng này vào thử coi

Sub abc()
Dim Sarr(), Darr(), i, j, x, usd
Sarr = Range("Q5", [Y65536].End(3)).Value
Darr = Range("E5", [Q65536].End(3).Offset(, -3)).Value
usd = [N2].Value
For i = 1 To UBound(Darr)
   If Darr(i, 1) <> "" Then
      For j = 2 To 10
         Select Case j
         Case 2, 3, 4, 5, 10
            If Darr(i, j) = "" Then
               Darr(i, j) = Sarr(i, j - 1)
            Else
               If Cells(i + 4, j + 4).Font.ColorIndex <> 3 Then
                  Darr(i, j) = Sarr(i, j - 1)
               End If
            End If
         Case 6
            If Darr(i, j) <> "" Then
               For x = 7 To 9
                  Darr(i, x) = Sarr(i, x - 1) * Darr(i, j) / usd
               Next
            End If
         End Select
      Next
   End If
Next
Range("E5", [Q65536].End(3).Offset(, -3)).Value = Darr
End Sub

Hoảng thật, hơn 5000 dòng mà 1s là xong vửa copy và vừa tính toán luôn.
.
Cảm ơn anh quanghai1969 nhiều nha.

 

[lengoctoan8x]

Chào các bác các chú cháu muốn copy dữ liệu (không bao gồm công thức ) lần lượt từng dòng một từ hàng 2 tới hàng 21 vào hàng 29(đã có săn công thức) sau mỗi lần bấm nút thì VBA này chỉnh sao ạ

 

[Canhho]

Chào mọi người, em muốn copy toàn bô sheet 1 sang sheet2 mà trong đó các công thức chức năng không đổi. Việc copy này dc thực hiện khi nhấn nút thêm đối tượng thì tạo ra sheet mới.

Cám ơn mọi người rất nhiều