Code Tính giá trị từ sheet1 sang sheet 2 (2 người xem)

[lhthai]

Chào các Anh
Hiện em có file gồm 8 sheet làm công thức nhiều nên dung lượng lớn
nên muốn chuyển sang code để giảm dung lượng file
Bảng tính của em chỉ là công thức nhân và chọn giá trị tuyệt đối của dòng thôi
Các anh xem file đính kèm.

 

[Ba Tê]

Chào các Anh
Hiện em có file gồm 8 sheet làm công thức nhiều nên dung lượng lớn
nên muốn chuyển sang code để giảm dung lượng file
Bảng tính của em chỉ là công thức nhân và chọn giá trị tuyệt đối của dòng thôi
Các anh xem file đính kèm.

Chạy thử cái này coi kết quả có đúng ý không?
Giải thích cũng chưa hiểu lắm.

Public Sub GPE()
Application.ScreenUpdating = False
Dim Arr(), I As Long, J As Long, C As Long
With Sheet1
    C = .[IV1].End(xlToLeft).Column
    Arr = .Range(.[A1], .[A65536].End(xlUp)).Resize(, C).Value
End With
For I = 10 To UBound(Arr, 1)
    For J = 5 To C
        Arr(I, J) = Arr(I, J) * Arr(1, J)
    Next J
Next I
With Sheet2
    Cells.ClearContents
    [A1].Resize(UBound(Arr, 1), C) = Arr
End With
Application.ScreenUpdating = True
End Sub

 

[lhthai]

Chạy thử cái này coi kết quả có đúng ý không?
Giải thích cũng chưa hiểu lắm.

Public Sub GPE()
Application.ScreenUpdating = False
Dim Arr(), I As Long, J As Long, C As Long
With Sheet1
    C = .[IV1].End(xlToLeft).Column
    Arr = .Range(.[A1], .[A65536].End(xlUp)).Resize(, C).Value
End With
For I = 10 To UBound(Arr, 1)
    For J = 5 To C
        Arr(I, J) = Arr(I, J) * Arr(3, J)
    Next J
Next I
With Sheet2
    Cells.ClearContents
    [A1].Resize(UBound(Arr, 1), C) = Arr
End With
Application.ScreenUpdating = True
End Sub

Kết quả rất đúng nhưng em muốn kết quả trả về từ cột F trở đi thôi tại vì cột E em để cộng thức để chia đơn vị tính
Anh có thể chỉnh sữa lại 1 chút em nha
Cám ơn anh rất nhiều.

 

[lhthai]

Chào Anh Ba Tê
Em sữa code chạy được nhưng dư phân đuôi em tô màu vàng, anh xem trong file đính kèm

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Arr(), I As Long, J As Long, C As Long
With Sheet1
    C = .[E1].End(xlToRight).Column
    Arr = .Range(.[E1], .[E65536].End(xlUp)).Resize(, C).Value
End With
For I = 10 To UBound(Arr, 1)
    For J = 1 To C
        Arr(I, J) = Arr(I, J) * Arr(3, J)
    Next J
Next I
With Sheet2
    Range("F1:IV5000").ClearContents
    [F1].Resize(UBound(Arr, 1), C) = Arr
End With
Application.ScreenUpdating = True
End Sub

 

[Ba Tê]

Chào Anh Ba Tê
Em sữa code chạy được nhưng dư phân đuôi em tô màu vàng, anh xem trong file đính kèm

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim Arr(), I As Long, J As Long, C As Long
With Sheet1
    C = .[E1].End(xlToRight).Column
    Arr = .Range(.[E1], .[E65536].End(xlUp)).Resize(, C).Value
End With
For I = 10 To UBound(Arr, 1)
    For J = 1 To C
        Arr(I, J) = Arr(I, J) * Arr(3, J)
    Next J
Next I
With Sheet2
    Range("F1:IV5000").ClearContents
    [F1].Resize(UBound(Arr, 1), C) = Arr
End With
Application.ScreenUpdating = True
End Sub

Siêng quá ta! Lúc đầu nói rõ thì đâu cần chỉnh sửa.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim sArr(), Arr(), I As Long, J As Long, C As Long
With Sheet1
    C = .[E1].End(xlToRight).Column - 4
    sArr = .Range(.[A10], .[A65536].End(xlUp)).Resize(, 4).Value2
    Arr = .Range(.[E1], .[E65536].End(xlUp)).Resize(, C).Value2
End With
For I = 10 To UBound(Arr, 1)
    For J = 1 To C
        Arr(I, J) = Arr(I, J) * Arr(3, J)
    Next J
Next I
With Sheet2
    Range("A10:D5000,F1:IV5000").ClearContents
    [A10].Resize(UBound(sArr, 1), 4) = sArr
    [F1].Resize(UBound(Arr, 1), C) = Arr
End With
Application.ScreenUpdating = True
End Sub

 

[lhthai]

Siêng quá ta! Lúc đầu nói rõ thì đâu cần chỉnh sửa.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim sArr(), Arr(), I As Long, J As Long, C As Long
With Sheet1
    C = .[E1].End(xlToRight).Column - 4
    sArr = .Range(.[A10], .[A65536].End(xlUp)).Resize(, 4).Value2
    Arr = .Range(.[E1], .[E65536].End(xlUp)).Resize(, C).Value2
End With
For I = 10 To UBound(Arr, 1)
    For J = 1 To C
        Arr(I, J) = Arr(I, J) * Arr(3, J)
    Next J
Next I
With Sheet2
    Range("A10:D5000,F1:IV5000").ClearContents
    [A10].Resize(UBound(sArr, 1), 4) = sArr
    [F1].Resize(UBound(Arr, 1), C) = Arr
End With
Application.ScreenUpdating = True
End Sub

Cám ơn Anh Ba Tê rất nhiều