Bài toán ví dụ về mảng mong các thầy giúp đỡ ạ.

[hadoan-pap]

Dear các thầy, anh/chị.

em có 1 bài toán về mảng như file đính kèm. các Mã ở Sheet5 sẽ đc tham chiếu từ Sheet4 và nội dung như trong file ạ.

Ở Sheet4 thì các hang k cố định và có thể bị thay đổi liên tục, còn sheet5 thì các hang là cố định.

Đoạn code trong file đang chạy rất chậm, e rất mong mọi ng giúp e tôi ưu nó hơn đc k ạ.

E xin cảm ơn!

 

[giaiphap]

Dear các thầy, anh/chị.

em có 1 bài toán về mảng như file đính kèm. các Mã ở Sheet5 sẽ đc tham chiếu từ Sheet4 và nội dung như trong file ạ.

Ở Sheet4 thì các hang k cố định và có thể bị thay đổi liên tục, còn sheet5 thì các hang là cố định.

Đoạn code trong file đang chạy rất chậm, e rất mong mọi ng giúp e tôi ưu nó hơn đc k ạ.

E xin cảm ơn!

Bạn thử code này xem sao.

Sub Sheet5_Button1_Click()
With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
Dim Arr, dArr, sArr(1 To 1, 1 To 148), Rng As Range
Dim a As Long, b As Long, i As Long, j As Long, k As Long
dArr = Sheets("Sheet5").Range("D4").Resize(, 147).Value
sArr(1, 1) = "Total"
With Sheets("Sheet4")
Set Rng = .Range("B:B").Find("Total")
Arr = .Range("b3:ab" & Rng.Row).Value
    For i = 1 To UBound(Arr, 2)
          For j = 1 To 147
            If Arr(1, i) = dArr(1, j) Then
                sArr(1, j + 1) = Arr(UBound(Arr), i)
                Exit For
            End If
          Next j
    Next i
    Sheets("Sheet5").Range("C10").Resize(, 148) = sArr
End With
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

 

[hadoan-pap]

Bạn thử code này xem sao.

Sub Sheet5_Button1_Click()
With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
Dim Arr, dArr, sArr(1 To 1, 1 To 148), Rng As Range
Dim a As Long, b As Long, i As Long, j As Long, k As Long
dArr = Sheets("Sheet5").Range("D4").Resize(, 147).Value
sArr(1, 1) = "Total"
With Sheets("Sheet4")
Set Rng = .Range("B:B").Find("Total")
Arr = .Range("b3:ab" & Rng.Row).Value
    For i = 1 To UBound(Arr, 2)
          For j = 1 To 147
            If Arr(1, i) = dArr(1, j) Then
                sArr(1, j + 1) = Arr(UBound(Arr), i)
                Exit For
            End If
          Next j
    Next i
    Sheets("Sheet5").Range("C10").Resize(, 148) = sArr
End With
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Dear Anh/Chị.

Em có thử và code này chạy đúng rồi ạ. Tuy nhiên chỉ nhầm ở 1 chỗ là tại Sheet5 em k muốn gán chữ Total sang, Vì chữ " Total " ở sheet5 là do e gõ, còn thực tế thì nó có thể là chữ khác k quan trọng, quan trọng là các giá trị gán đúng bắt đầu từ D10 ạ. Còn C10 để nguyên vì text của nó k cần tham chiếu từ sheet4 sang ạ.

Nhờ Anh/Chị sửa lại giúp em chút nhé.

E xin cảm ơn!

 

[giaiphap]

Dear Anh/Chị.

Em có thử và code này chạy đúng rồi ạ. Tuy nhiên chỉ nhầm ở 1 chỗ là tại Sheet5 em k muốn gán chữ Total sang, Vì chữ " Total " ở sheet5 là do e gõ, còn thực tế thì nó có thể là chữ khác k quan trọng, quan trọng là các giá trị gán đúng bắt đầu từ D10 ạ. Còn C10 để nguyên vì text của nó k cần tham chiếu từ sheet4 sang ạ.

Nhờ Anh/Chị sửa lại giúp em chút nhé.

E xin cảm ơn!

Sửa lại chút chắc được (Chưa test nhé, bạn tự test vậy).

Sub Sheet5_Button1_Click()
With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
Dim Arr, dArr, sArr(1 To 1, 1 To 147), Rng As Range
Dim a As Long, b As Long, i As Long, j As Long, k As Long
dArr = Sheets("Sheet5").Range("D4").Resize(, 147).Value

With Sheets("Sheet4")
Set Rng = .Range("B:B").Find("Total")
Arr = .Range("b3:ab" & Rng.Row).Value
    For i = 1 To UBound(Arr, 2)
          For j = 1 To 147
            If Arr(1, i) = dArr(1, j) Then
                sArr(1, j) = Arr(UBound(Arr), i)
                Exit For
            End If
          Next j
    Next i
    Sheets("Sheet5").Range("D10").Resize(, 147) = sArr
End With
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

 

[hadoan-pap]

Sửa lại chút chắc được (Chưa test nhé, bạn tự test vậy).

Sub Sheet5_Button1_Click()
With Application
.Interactive = False
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
Dim Arr, dArr, sArr(1 To 1, 1 To 147), Rng As Range
Dim a As Long, b As Long, i As Long, j As Long, k As Long
dArr = Sheets("Sheet5").Range("D4").Resize(, 147).Value

With Sheets("Sheet4")
Set Rng = .Range("B:B").Find("Total")
Arr = .Range("b3:ab" & Rng.Row).Value
    For i = 1 To UBound(Arr, 2)
          For j = 1 To 147
            If Arr(1, i) = dArr(1, j) Then
                sArr(1, j) = Arr(UBound(Arr), i)
                Exit For
            End If
          Next j
    Next i
    Sheets("Sheet5").Range("D10").Resize(, 147) = sArr
End With
.Interactive = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Em cảm ơn ạ

Đúng cái e muốn rồi ^^

 

[hadoan-pap]

Dear anh,

Em có bài toán như file đính kèm.

E tham chiếu từ Sheet1 sang Sheet2... nhưng code đang bị sai k như ý muốn vì gần như nó chỉ sao chép từ sheet1 sang sheet2 kể cả những khoảng trắng. E chỉ muốn nó tham chiếu đúng giá trị " Mã Hàng " thì đưa sang.

A xem giúp em ạ.

Cảm ơn anh!