Xin giúp đỡ - tăng tốc khi chạy code chuyển/ copy dữ liệu giữa các sheet (1 người xem)

[anhdepjai]

Xin chào các anh chị GPE,

Như tiêu đề, em muốn nhờ mọi người viết giúp 1 đoạn code để làm 1 việc sau:
Sheet “Temp” có nhiều data, xét cột 20 và cột 21, nếu gặp điều kiện (cột 20 = “1:FIRST” và cột 21 = “F:FINISHED”) thì nó copy cả dòng và chuyển sang sheet “Transfer”.

Em đã viết code thử nhưng tốc độ copy từng dòng rồi lại test từng dòng và copy chậm. Mong các bác giúp em làm sao cho code chạy nhanh hơn với ah

Thanks

 

[mhung12005]

Xin chào các anh chị GPE,

Như tiêu đề, em muốn nhờ mọi người viết giúp 1 đoạn code để làm 1 việc sau:
Sheet “Temp” có nhiều data, xét cột 20 và cột 21, nếu gặp điều kiện (cột 20 = “1:FIRST” và cột 21 = “F:FINISHED”) thì nó copy cả dòng và chuyển sang sheet “Transfer”.

Em đã viết code thử nhưng tốc độ copy từng dòng rồi lại test từng dòng và copy chậm. Mong các bác giúp em làm sao cho code chạy nhanh hơn với ah

Thanks

Bạn thử code này xe sao nhé:

Sub copydong()   
   Dim SrcArr, ResArr()
   Dim lR As Long, lC As Long, k As Long, lLastRow As Long
   
   With Sheets("Temp")
      lLastRow = .Range("A65000").End(xlUp).Row
      If lLastRow > 1 Then SrcArr = .Range("A2:A" & lLastRow).Resize(, 81).Value2
   End With
   If lLastRow > 1 Then
      ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 81)
      For lR = 1 To UBound(SrcArr, 1)
         If SrcArr(lR, 20) = "1:FIRST" Then
            If SrcArr(lR, 21) = "F:FINISHED" Then
               k = k + 1
               For lC = 1 To 81
                  ResArr(k, lC) = SrcArr(lR, lC)
               Next lC
            End If
         End If
      Next lR
   
      If k Then
         Sheets("Transfer").Range("A2:CC10000").ClearContents
         Sheets("Transfer").Range("A2").Resize(k, lC).Value = ResArr
      End If
   End If
   
End Sub

 

[HungQuoc49]

Xin chào các anh chị GPE,

Như tiêu đề, em muốn nhờ mọi người viết giúp 1 đoạn code để làm 1 việc sau:
Sheet “Temp” có nhiều data, xét cột 20 và cột 21, nếu gặp điều kiện (cột 20 = “1:FIRST” và cột 21 = “F:FINISHED”) thì nó copy cả dòng và chuyển sang sheet “Transfer”.

Em đã viết code thử nhưng tốc độ copy từng dòng rồi lại test từng dòng và copy chậm. Mong các bác giúp em làm sao cho code chạy nhanh hơn với ah

Thanks

Thử nghiệm code này xem sao

Public Sub Copy_Mang()
Sheet10.UsedRange.Clear

With Sheet9.UsedRange
.AutoFilter Field:=20, Criteria1:="1:FIRST"
.AutoFilter Field:=21, Criteria1:="F:FINISHED"
.SpecialCells(xlCellTypeVisible).Copy Sheet10.Range("A1")
.AutoFilter
End With

Sheet10.UsedRange.Columns.AutoFit
End Sub

 

[Ba Tê]

Xin chào các anh chị GPE,

Như tiêu đề, em muốn nhờ mọi người viết giúp 1 đoạn code để làm 1 việc sau:
Sheet “Temp” có nhiều data, xét cột 20 và cột 21, nếu gặp điều kiện (cột 20 = “1:FIRST” và cột 21 = “F:FINISHED”) thì nó copy cả dòng và chuyển sang sheet “Transfer”.

Em đã viết code thử nhưng tốc độ copy từng dòng rồi lại test từng dòng và copy chậm. Mong các bác giúp em làm sao cho code chạy nhanh hơn với ah

Thanks

Thử bằng Advanced Filter xem:

Sub GPE()
[IU1].Value = "Grade": [IV1].Value = "Status"
[IU2].Value = "1:FIRST": [IV2].Value = "F:FINISHED"
[A1:CC1000].Clear
Sheets("Temp").Range("A1:CC1000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("IU1:IV2"), CopyToRange:=Range("A1")
[IU1:IV2].Clear
End Sub

 

[anhdepjai]

Thử bằng Advanced Filter xem:

Sub GPE()
[IU1].Value = "Grade": [IV1].Value = "Status"
[IU2].Value = "1:FIRST": [IV2].Value = "F:FINISHED"
[A1:CC1000].Clear
Sheets("Temp").Range("A1:CC1000").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("IU1:IV2"), CopyToRange:=Range("A1")
[IU1:IV2].Clear
End Sub

OK được rồi bác ah. Em cảm ơn nhé

 

[anhdepjai]

Bác Ba Tê và các anh chị giúp em xem có thể tăng tốc đoạn code sau lên được không ah?
(Mục đích là add 3 dòng vào 1 tem nhãn, rồi in. Lặp lại đến hết số dòng ah)
For i = 2 To irow1 Step 3
'************************************************ First label
Sheet3.Range("E10") = UCase(Sheet10.Cells(i, 42))
Sheet3.Range("K10") = "*" & UCase(Sheet10.Cells(i, 42)) & "*"
Sheet3.Range("T14") = Format(Now, "mm/dd")
Sheet3.Range("U14") = Format(Now, "hh:mm")
Sheet3.Range("E15") = Sheet10.Cells(i, 12)
Sheet3.Range("K15") = Sheet10.Cells(i, 1)
Sheet3.Range("Q15") = Format(Sheet10.Cells(i, 32), "mm-dd-yyyy")
Sheet3.Range("E19") = Sheet10.Cells(i, 6) & "x" & Sheet10.Cells(i, 7) & "x" & Sheet10.Cells(i, 8)
Sheet3.Range("J19") = Sheet10.Cells(i, 10)
Sheet3.Range("M19") = Sheet10.Cells(i, 9) & "kg"
Sheet3.Range("Q19") = Sheet10.Cells(i, 25)
Sheet3.Range("E24") = Sheet10.Cells(i, 4)
Sheet3.Range("K24") = Sheet10.Cells(i, 36) & "/" & Sheet10.Cells(i, 36)
Sheet3.Range("N24") = Sheet10.Cells(i, 38)
Sheet3.Range("P24") = Sheet10.Cells(i, 28)
Sheet3.Range("C28") = "*" & UCase(Sheet10.Cells(i, 42)) & "*"
Sheet3.Range("K29") = Sheet10.Cells(i, 41)
Sheet3.Range("Q29") = Sheet10.Cells(i, 30)
'************************************************ Second label
Sheet3.Range("E34") = UCase(Sheet10.Cells(i + 1, 42))
Sheet3.Range("K34") = "*" & UCase(Sheet10.Cells(i + 1, 42)) & "*"
Sheet3.Range("T38") = Format(Now, "mm/dd")
Sheet3.Range("U38") = Format(Now, "hh:mm")
Sheet3.Range("E39") = Sheet10.Cells(i + 1, 12)
Sheet3.Range("K39") = Sheet10.Cells(i + 1, 1)
Sheet3.Range("Q39") = Format(Sheet10.Cells(i + 1, 32), "mm-dd-yyyy")
Sheet3.Range("E43") = Sheet10.Cells(i + 1, 6) & "x" & Sheet10.Cells(i + 1, 7) & "x" & Sheet10.Cells(i + 1, 8)
Sheet3.Range("J43") = Sheet10.Cells(i + 1, 10)
Sheet3.Range("M43") = Sheet10.Cells(i + 1, 9) & "kg"
Sheet3.Range("Q43") = Sheet10.Cells(i + 1, 25)
Sheet3.Range("E48") = Sheet10.Cells(i + 1, 4)
Sheet3.Range("K48") = Sheet10.Cells(i + 1, 36) & "/" & Sheet10.Cells(i + 1, 36)
Sheet3.Range("N48") = Sheet10.Cells(i + 1, 38)
Sheet3.Range("P48") = Sheet10.Cells(i + 1, 28)
Sheet3.Range("C52") = "*" & UCase(Sheet10.Cells(i + 1, 42)) & "*"
Sheet3.Range("K53") = Sheet10.Cells(i + 1, 41)
Sheet3.Range("Q53") = Sheet10.Cells(i + 1, 30)
'************************************************ Thirst label
Sheet3.Range("E58") = UCase(Sheet10.Cells(i + 2, 42))
Sheet3.Range("K58") = "*" & UCase(Sheet10.Cells(i + 2, 42)) & "*"
Sheet3.Range("T62") = Format(Now, "mm/dd")
Sheet3.Range("U62") = Format(Now, "hh:mm")
Sheet3.Range("E63") = Sheet10.Cells(i + 2, 12)
Sheet3.Range("K63") = Sheet10.Cells(i + 2, 1)
Sheet3.Range("Q63") = Format(Sheet10.Cells(i + 2, 32), "mm-dd-yyyy")
Sheet3.Range("E67") = Sheet10.Cells(i + 2, 6) & "x" & Sheet10.Cells(i + 2, 7) & "x" & Sheet10.Cells(i + 2, 8)
Sheet3.Range("J67") = Sheet10.Cells(i + 2, 10)
Sheet3.Range("M67") = Sheet10.Cells(i + 2, 9) & "kg"
Sheet3.Range("Q67") = Sheet10.Cells(i + 2, 25)
Sheet3.Range("E72") = Sheet10.Cells(i + 2, 4)
Sheet3.Range("K72") = Sheet10.Cells(i + 2, 36) & "/" & Sheet10.Cells(i + 2, 36)
Sheet3.Range("N72") = Sheet10.Cells(i + 2, 38)
Sheet3.Range("P72") = Sheet10.Cells(i + 2, 28)
Sheet3.Range("C76") = "*" & UCase(Sheet10.Cells(i + 2, 42)) & "*"
Sheet3.Range("K77") = Sheet10.Cells(i + 2, 41)
Sheet3.Range("Q77") = Sheet10.Cells(i + 2, 30)
Sheet3.Activate
Application.ActivePrinter = "\\HUONGVTT\SATO GL408e on Ne05:"
ExecuteExcel4Macro "PRINT(1,,,1,2,,,TRUE,,FALSE)"

 

[anhdepjai]

Gửi cả nhà,

Em đã thay code bằng loạt vlookup và nó nhanh hơn nhiều rồi
E xin cảm ơn