Chuyển file công thức excel thành code VBA (2 người xem)

[LightStar252]

Ai giúp mình chuyển mấy công thức excel này thành code VBA cho đỡ nặng với ạ, hoặc là giúp mình code VBA tìm kiếm và tổng hợp dữ liệu thay thế các công thức excel cũng được ạ!

 

[PacificPR]

Ai giúp mình chuyển mấy công thức excel này thành code VBA cho đỡ nặng với ạ, hoặc là giúp mình code VBA tìm kiếm và tổng hợp dữ liệu thay thế các công thức excel cũng được ạ!

Trong File có code

Sub baocaodaumaythang()
'
' baocaodaumaythang Macro
'

'
' so may
' =IFERROR(INDEX('BCHN.T1.2017.xls'!SM,MATCH(0,COUNTIF(C$9:$C11,'BCHN.T1.2017 .xls'!SM),0)),"")
    Range("C12").Select
    Selection.FormulaArray = _
        "=IFERROR(INDEX('BCHN.T1.2017.xls'!SM,MATCH(0,COUNTIF(R9C:R[-1]C3,'BCHN.T1.2017.xls'!SM),0)),"""")"
' loai may
' =IFERROR((VLOOKUP(C12,CSDL!$B$10:$C$275,2,0))," ")
    Range("B12").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR((VLOOKUP(RC[1],CSDL!R10C2:R275C3,2,0)),"" "")"
' dm chieu cao
' =IFERROR((VLOOKUP(C12,CSDL!$B$10:$H$275,5,0))," ")
    Range("D12").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR((VLOOKUP(RC[-1],CSDL!R10C2:R275C8,5,0)),"" "")"
' dm gio
' =IFERROR((VLOOKUP(C12,CSDL!$B$10:$H$275,6,0)),"")
    Range("E12").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR((VLOOKUP(RC[-2],CSDL!R10C2:R275C8,6,0)),"""")"
' tong gio
' =IF(C12<>"",SUMIF(BCHN!$D$10:$D$3139,C12,BCHN!$I$10:$I$3139),"")
    Range("F12").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-3]<>"""",SUMIF(BCHN!R10C4:R3139C4,RC[-3],BCHN!R10C9:R3139C9),"""")"
' tong dau
' =IF(C12<>"",SUMIF(BCHN!$D$10:$D$3139,C12,BCHN!$J$10:$J$3139),"")
    Range("G12").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-4]<>"""",SUMIF(BCHN!R10C4:R3139C4,RC[-4],BCHN!R10C10:R3139C10),"""")"
' ton dau dau
' =IF(D12="K do dc",0,IFERROR(J12*D12,""))
    Range("H12").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]=""K do dc"",0,IFERROR(RC[2]*RC[-4],""""))"
' ton dau cuoi
' =IF(D12="K do dc",0,IFERROR(K12*D12,""))
    Range("I12").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-5]=""K do dc"",0,IFERROR(RC[2]*RC[-5],""""))"
' chieu cao dau dau
' =IFERROR(OFFSET(INDEX('BCHN.T1.2017.xls'!data, MATCH(C12&$A$6, 'BCHN.T1.2017.xls'!SM&Ngay, 0), MATCH($J$9,BCHN!$C$8:$O$8,0)),2,0),"")
    Range("J12").Select
    Selection.FormulaArray = _
        "=IFERROR(OFFSET(INDEX('BCHN.T1.2017.xls'!data, MATCH(RC[-7]&R6C1, 'BCHN.T1.2017.xls'!SM&Ngay, 0), MATCH(R9C10,BCHN!R8C3:R8C15,0)),2,0),"""")"
' chieu cao dau cuoi
' =IFERROR((OFFSET(INDEX('BCHN.T1.2017 .xls'!data, MATCH(C12&$A$7, 'BCHN.T1.2017.xls'!SM&Ngay, 0), MATCH($K$9,BCHN!$C$8:$Q$8, 0)),2,0)),"")
    Range("K12").Select
    Selection.FormulaArray = _
        "=IFERROR((OFFSET(INDEX('BCHN.T1.2017.xls'!data, MATCH(RC[-8]&R7C1, 'BCHN.T1.2017.xls'!SM&Ngay, 0), MATCH(R9C11,BCHN!R8C3:R8C17, 0)),2,0)),"""")"

' dau theo dinh muc
' =IFERROR(F12*E12,"")
    Range("L12").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-6]*RC[-7],"""")"
' ton dau
' =IFERROR(L12-(G12+H12-I12),"")
    Range("M12").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(RC[-1]-(RC[-6]+RC[-5]-RC[-4]),"""")"
' tieu thu dau trung binh
' =IFERROR(IF(F12=0,"",(H12+G12-I12)/F12),"")
    Range("N12").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(RC[-8]=0,"""",(RC[-6]+RC[-7]-RC[-5])/RC[-8]),"""")"
' chenh lech gio thuc te
' =IFERROR(IF(F12=0,"",E12-N12),"")
    Range("O12").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(IF(RC[-9]=0,"""",RC[-10]-RC[-1]),"""")"
' cong truong
' =IFERROR((VLOOKUP(C12,LK!$C$12:$P$128,14,0))," ")
    Range("P12").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR((VLOOKUP(RC[-13],LK!R12C3:R128C16,14,0)),"" "")"
' =1
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("A13").Select
' so thu tu
' =IF(C13<>"",A12+1,"")
    ActiveCell.FormulaR1C1 = "=IF(RC[2]<>"""",R[-1]C+1,"""")"
    Range("B12:P12").Select
    Selection.AutoFill Destination:=Range("B12:P128"), Type:=xlFillDefault
    Range("B12:P128").Select
    ActiveWindow.SmallScroll Down:=-129
    Range("A13").Select
    Selection.AutoFill Destination:=Range("A13:A128"), Type:=xlFillDefault
    Range("A13:A128").Select
    ActiveWindow.SmallScroll Down:=-123
    Range("A12:P128").Select
    ActiveWindow.SmallScroll Down:=-120
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C9:C10").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "S? máy"
    Range("C11").Select
' ham tinh tong ton dau (du tru dung sau): k lien quan lam =SUMIFS(BCHN!$J$10:$J$3264,'BCHN.T1.2017 .xls'!Ngay,"<="&$A$7,'BCHN.T1.2017 .xls'!SM,C12)-SUMIFS(BCHN!$Q$10:$Q$3264,'BCHN.T1.2017 .xls'!Ngay,"<="&$A$7,SM,C12)

End Sub

Mà cũng khóa làm gì vậy trời

 

[LightStar252]

Ôi mình quên mất. Pass là: "cachoi252" nhé bạn

 

[Ba Tê]

Trong File có code
......................................
Mà cũng khóa làm gì vậy trời

Code "khủng" thiệt.
Khóa là phải, kẻo mọi người "chôm chĩa".

 

[LightStar252]

Code này của mình mà )

 

[huonglien1901]

Code "khủng" thiệt.
Khóa là phải, kẻo mọi người "chôm chĩa".

Bác BaTe cái này hình như liên quan đến xây dựng đó Bác nên cần phải bảo mật đây. Chắc có gì quan trọng đây

 

[LightStar252]

Code "khủng" thiệt.
Khóa là phải, kẻo mọi người "chôm chĩa".

Mình mới tìm hiểu về VBA nên mn đừng cười ). Mình khóa là do k muốn bị soi mói chứ code cùi của mình ai thèm lấy chứ )

 

[PacificPR]

Mình mới tìm hiểu về VBA nên mn đừng cười ). Mình khóa là do k muốn bị soi mói chứ code cùi của mình ai thèm lấy chứ )

Cái chiều cao dầu đầu (10) và chiều cao chiều cuối (11) lấy sang như thế nào. Mình đọc công thức không hiểu

 

[LightStar252]

Có cách nào khác chỉ dùng code VBA thôi chứ không phải dùng công thức Excel, rồi lại chuyển từ công thức excel sang code như thế này k mn

 

[PacificPR]

Có cách nào khác chỉ dùng code VBA thôi chứ không phải dùng công thức Excel, rồi lại chuyển từ công thức excel sang code như thế này k mn

1 tháng của bạn có 30 ngày chẳng hạn thì file BCTH cột 10 và cột 11 tính như thế nào

 

[LightStar252]

1 tháng của bạn có 30 ngày chẳng hạn thì file BCTH cột 10 và cột 11 tính như thế nào

Chiều cao dầu đó tìm kiếm theo 2 điều kiện ngày tháng và cột "chiều cao dầu đầu" hay "chiều cao dầu cuối" ở sheet BCHN đó. Còn muốn tìm chiều cao ngày nào thì sửa 2 ô A6 và A7 ở sheet BCTH đấy

 

[phuyen89]

Code "khủng" thiệt.
Khóa là phải, kẻo mọi người "chôm chĩa".

Dạ khoá là phải, nhưng em nghĩ không phải để chôm chĩa, mà là hạn chế việc áp dụng code trên Anh ạ.Công nhận Code VBA do Macro sinh ra, phức tạp thật.

 

[PacificPR]

Chiều cao dầu đó tìm kiếm theo 2 điều kiện ngày tháng và cột "chiều cao dầu đầu" hay "chiều cao dầu cuối" ở sheet BCHN đó. Còn muốn tìm chiều cao ngày nào thì sửa 2 ô A6 và A7 ở sheet BCTH đấy

Bạn thử xem file xem có đúng không

 

[LightStar252]

Bạn thử xem file xem có đúng không

Chuẩn men rồi bạn ơi. Thanks bạn nhé

 

[quocthan92]

Bạn thử xem file xem có đúng không

Cao thu giai thich doan code nay de minh tham khao nhe

 

[phuyen89]

Cao thu giai thich doan code nay de minh tham khao nhe

Public Sub Tonghop()
    Dim sArr(), tArr(), dArr(), I As Long, K As Long, Thang As Long
    Dim Dic As Object, Tem As String
Set Dic = CreateObject("Scripting.Dictionary") ' tao mot doi tung DIC
Thang = Month(Sheets("BCTH").Range("G6")) 'Lay gia tri Thang tai G6 gan vao bien Thang
With Sheets("CSDL")
    tArr = .Range(.Range("B11"), .Range("B65535").End(3)).Resize(, 6).Value ' chon Vung tu B1 den , co du lieu cuoi cung
End With
For I = 1 To UBound(tArr, 1) ' cho bien I chay tu B4 cho den cuoi cung co chua du lieu
    Dic.Item(tArr(I, 1)) = I ' Thiet lap gia tri Item bang I
Next I
With Sheets("BCHN")
    sArr = .Range(.Range("B10"), .Range("B65535").End(3)).Resize(, 15).Value ' chon vung du lieu B10 den cot P co chua du lieu cuoi cung
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 15) ' Xac dinh lai kich co cua mang dArr
For I = 1 To UBound(sArr, 1)                ' Cho Bien I chay tu 1 cho den het trong cot B
    If Month(sArr(I, 1)) = Thang Then       ' Neu tung dong, co thang = gia tri thang da khai bao ben sheet BCTH thi
        Tem = sArr(I, 3)                    ' Them so may vao bien Tem
        If Not Dic.Exists(Tem) Then         ' Kiem tra trong Dic co so may chua?
            K = K + 1                       ' Tang bien K len
            Dic.Add Tem, K                  ' Chua co thi Add vao, Key la Tem, Items la K
            dArr(K, 1) = K                  ' Them vao mang darr STT K,
            dArr(K, 2) = sArr(I, 2)         'Them Loai may vao mang
            dArr(K, 3) = Tem                ' Them So May vao mang
            dArr(K, 4) = tArr(Dic.Item(Tem), 5) 'Them Dinh Muc theo chieu cao vao mang
            dArr(K, 5) = tArr(Dic.Item(Tem), 6) ' Them Dinh Muc theo So Lit vao mang
            dArr(K, 6) = sArr(I, 8)             'Them Gio lam vao mang
            dArr(K, 7) = sArr(I, 9)             'Them Dau Nhan vao Mang
            dArr(K, 10) = sArr(I, 6)            ' Them Chieu cao dau dau
            dArr(K, 11) = ""                    ' Trong
        Else
            dArr(Dic.Item(Tem), 6) = dArr(Dic.Item(Tem), 6) + sArr(I, 8)
            dArr(Dic.Item(Tem), 7) = dArr(Dic.Item(Tem), 7) + sArr(I, 9)
            dArr(Dic.Item(Tem), 11) = sArr(I, 7)
            dArr(K, 8) = dArr(K, 4) * dArr(K, 10): dArr(K, 9) = dArr(K, 4) * dArr(K, 11)
            dArr(K, 12) = dArr(K, 5) * dArr(K, 6)
            dArr(K, 13) = dArr(K, 12) - (dArr(K, 7) + dArr(K, 8) - dArr(K, 9))
            dArr(K, 14) = (dArr(K, 8) + dArr(K, 7) - dArr(K, 9)) / dArr(K, 6)
            dArr(K, 15) = dArr(K, 5) - dArr(K, 14)
        End If
    End If
Next I
With Sheets("BCTH")                                                     ' chon Sheet
    .Range("A12:P" & .Range("A65535").End(3).Row + 1).ClearContents     ' Xac dinh vung du lieu can xoa
    .Range("A12").Resize(K, 15) = dArr                                  ' Xac dinh Vung du lieu can dan Mang xuong bang tinh
End With
Set Dic = Nothing
End Sub

Hy vọng giúp đỡ được bạn./

 

[quocthan92]

Minh hiểu rồi, thank so much!
P/s: Mình có 1 câu hỏi them là muốn viết code copy dữ liệu "A1:A100" row lẽ thì paste cột "B1:B50" chẳn thì "C1:C50"

 

[PacificPR]

Minh hiểu rồi, thank so much!
P/s: Mình có 1 câu hỏi them là muốn viết code copy dữ liệu "A1:A100" row lẽ thì paste cột "B1:B50" chẳn thì "C1:C50"

Sao đã "lẽ thì " rồi còn "chẳn thì" . Bạn cần diễn đạt rõ ràng thêm .......
Bạn chú ý không dùng mấy từ thank so much! này

 

[befaint]

muốn viết code copy dữ liệu "A1:A100" row lẽ thì paste cột "B1:B50" chẳn thì "C1:C50"

Sao mà ngọng ghê gớm thế hả chời?
(Nếu mà nghe nói chắc loạn tai luôn!)

https://vi.wikipedia.org/wiki/Tính_chẵn_lẻ

 

[PacificPR]

Sao mà ngọng ghê gớm thế hả chời?
(Nếu mà nghe nói chắc loạn tai luôn!)

https://vi.wikipedia.org/wiki/Tính_chẵn_lẻ

Ồ may nhờ anh em mới hiểu bạn ấy nói gì Lẽ chẳn có nghĩa là chẵn lẻ. (Có nghĩa là Copy từ A1 đến A100, nếu dòng chẵn thì điền vào cột B, dòng lẻ điền vào cột C)
Tiếng việt phong phú qua anh ạ