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

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
L

LightStar252

Thành viên hoạt động
Tham gia
9/7/16
Bài viết
112
Được thích
10
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 ạ!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
PacificPR đã viết:
Ồ 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 ạ :eek:
Nhấp chuột vào đây để mở rộng...
Đây không phải là trường hợp phong phú. Đây là vấn đề học tiếng Việt.
Chê ngọng cái chạy mất dép luôn. Thất kha khá trường hợp, bị chê cái... khoảng 1 phút sau khi đọc bài thì nick tối thui. o_O
 
Upvote 0
Upvote 0
quocthan92 đã viết:
Bạn làm mình rối quá
Nhấp chuột vào đây để mở rộng...
Có gì đâu mà rối.
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"
Nhấp chuột vào đây để mở rộng...
Bạn viết tiếng Anh được (hổng biết trúng hông) nhưng tiếng Việt thì sai bét nên mọi người ngạc nhiên thôi.
Số chẵn, số lẻ. Bạn viết ...lẽ... chẳn thì...
Nên viết chuẩn tiếng Việt mới đúng là người Việt. Giỏi tiếng nước ngoài chỉ để trao đổi với người nước ngoài.
 
Upvote 0
PacificPR đã viết:
Bạn thử xem file xem có đúng không
Nhấp chuột vào đây để mở rộng...
Bạn ơi, giúp mình thêm một tí đc k. Mình muốn thêm đoạn code lấy tên công trường cuối tháng ở cột 0 sheet "BCHN" qua cột P sheet "BCTH" ấy, tháng có 30 ngày thì lấy tên công trường ngày 30, tháng 31 thì lấy tên công trường ngày 31... Mình mò mãi k đc (@$%@
 
Upvote 0
LightStar252 đã viết:
Bạn ơi, giúp mình thêm một tí đc k. Mình muốn thêm đoạn code lấy tên công trường cuối tháng ở cột 0 sheet "BCHN" qua cột P sheet "BCTH" ấy, tháng có 30 ngày thì lấy tên công trường ngày 30, tháng 31 thì lấy tên công trường ngày 31... Mình mò mãi k đc (@$%@
Nhấp chuột vào đây để mở rộng...
bạn thay Code cũ bằng cái này thử:
Mã: 
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")
Thang = Month(Sheets("BCTH").Range("G6"))
With Sheets("CSDL")
    tArr = .Range(.Range("B11"), .Range("B65535").End(3)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr, 1)
    Dic.Item(tArr(I, 1)) = I
Next I
With Sheets("BCHN")
    sArr = .Range(.Range("B10"), .Range("B65535").End(3)).Resize(, 15).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 16)
For I = 1 To UBound(sArr, 1)
    If Month(sArr(I, 1)) = Thang Then
        Tem = sArr(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2): dArr(K, 3) = Tem
            dArr(K, 4) = tArr(Dic.Item(Tem), 5): dArr(K, 5) = tArr(Dic.Item(Tem), 6)
            dArr(K, 6) = sArr(I, 8): dArr(K, 7) = sArr(I, 9)
            dArr(K, 10) = sArr(I, 6)
            dArr(K, 16) = sArr(I, 14)
        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), 16) = sArr(I, 14)
            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")
    .Range("A12:P" & .Range("A65535").End(3).Row + 1).ClearContents
    .Range("A12").Resize(K, 16) = dArr
End With
Set Dic = Nothing
End Sub
 
Upvote 0
PacificPR đã viết:
bạn thay Code cũ bằng cái này thử:
Mã: 
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")
Thang = Month(Sheets("BCTH").Range("G6"))
With Sheets("CSDL")
    tArr = .Range(.Range("B11"), .Range("B65535").End(3)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr, 1)
    Dic.Item(tArr(I, 1)) = I
Next I
With Sheets("BCHN")
    sArr = .Range(.Range("B10"), .Range("B65535").End(3)).Resize(, 15).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 16)
For I = 1 To UBound(sArr, 1)
    If Month(sArr(I, 1)) = Thang Then
        Tem = sArr(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2): dArr(K, 3) = Tem
            dArr(K, 4) = tArr(Dic.Item(Tem), 5): dArr(K, 5) = tArr(Dic.Item(Tem), 6)
            dArr(K, 6) = sArr(I, 8): dArr(K, 7) = sArr(I, 9)
            dArr(K, 10) = sArr(I, 6)
            dArr(K, 16) = sArr(I, 14)
        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), 16) = sArr(I, 14)
            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")
    .Range("A12:P" & .Range("A65535").End(3).Row + 1).ClearContents
    .Range("A12").Resize(K, 16) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
PacificPR đã viết:
bạn thay Code cũ bằng cái này thử:
Mã: 
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")
Thang = Month(Sheets("BCTH").Range("G6"))
With Sheets("CSDL")
    tArr = .Range(.Range("B11"), .Range("B65535").End(3)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr, 1)
    Dic.Item(tArr(I, 1)) = I
Next I
With Sheets("BCHN")
    sArr = .Range(.Range("B10"), .Range("B65535").End(3)).Resize(, 15).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 16)
For I = 1 To UBound(sArr, 1)
    If Month(sArr(I, 1)) = Thang Then
        Tem = sArr(I, 3)
        If Not Dic.Exists(Tem) Then
            K = K + 1
            Dic.Add Tem, K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2): dArr(K, 3) = Tem
            dArr(K, 4) = tArr(Dic.Item(Tem), 5): dArr(K, 5) = tArr(Dic.Item(Tem), 6)
            dArr(K, 6) = sArr(I, 8): dArr(K, 7) = sArr(I, 9)
            dArr(K, 10) = sArr(I, 6)
            dArr(K, 16) = sArr(I, 14)
        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), 16) = sArr(I, 14)
            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")
    .Range("A12:P" & .Range("A65535").End(3).Row + 1).ClearContents
    .Range("A12").Resize(K, 16) = dArr
End With
Set Dic = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Giúp mình thêm cái sheet "Âm dầu" này nữa được k bạn. Thanh bạn :))
 

File đính kèm

Upvote 0
LightStar252 đã viết:
Giúp mình thêm cái sheet "Âm dầu" này nữa được k bạn. Thanh bạn :))
Nhấp chuột vào đây để mở rộng...
Code lấy dầu Âm, Âm dầu đây
Mã: 
Sub DauAm()
    Dim sArr, dArr, tArr, I As Long, K As Long
    Dim Dic As Object, tem As String
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("CSDL")
        tArr = .Range(.Range("C11"), .Range("C65535").End(3)).Resize(, 8).Value
    End With
    For I = 1 To UBound(tArr, 1)
        Dic.Item(tArr(I, 1)) = I
    Next I
    With Sheets("BCTH")
        sArr = .Range(.Range("B12"), .Range("B65535").End(3)).Resize(, 15).Value
    End With
    ReDim dArr(1 To UBound(sArr), 1 To 9)
    For I = 1 To UBound(sArr)
        If sArr(I, 12) <= 100 Then
            tem = sArr(I, 1)
            K = K + 1
            dArr(K, 1) = K: dArr(K, 2) = sArr(I, 1): dArr(K, 3) = sArr(I, 2)
            dArr(K, 4) = sArr(I, 5): dArr(K, 5) = sArr(I, 6): dArr(K, 6) = sArr(I, 12)
            dArr(K, 7) = tArr(Dic.Item(tem), 7): dArr(K, 8) = tArr(Dic.Item(tem), 8): dArr(K, 9) = sArr(I, 15)
        End If
    Next I
    With Sheet3
        .Range("A6:I" & .Range("A65535").End(3).Row + 1).ClearContents
        .Range("A6").Resize(K, 9) = dArr
    End With
End Sub
P/s: Dầu âm là do máy tính chạy ra đừng trừ lương lái máy tội họ ( Có thì cho nghỉ việc :D nhẹ nhẹ vậy thôi...)
 
Upvote 0
PacificPR đã viết:
Code lấy dầu Âm, Âm dầu đây
Mã: 
Sub DauAm()
    Dim sArr, dArr, tArr, I As Long, K As Long
    Dim Dic As Object, tem As String
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("CSDL")
        tArr = .Range(.Range("C11"), .Range("C65535").End(3)).Resize(, 8).Value
    End With
    For I = 1 To UBound(tArr, 1)
        Dic.Item(tArr(I, 1)) = I
    Next I
    With Sheets("BCTH")
        sArr = .Range(.Range("B12"), .Range("B65535").End(3)).Resize(, 15).Value
    End With
    ReDim dArr(1 To UBound(sArr), 1 To 9)
    For I = 1 To UBound(sArr)
        If sArr(I, 12) <= 100 Then
            tem = sArr(I, 1)
            K = K + 1
            dArr(K, 1) = K: dArr(K, 2) = sArr(I, 1): dArr(K, 3) = sArr(I, 2)
            dArr(K, 4) = sArr(I, 5): dArr(K, 5) = sArr(I, 6): dArr(K, 6) = sArr(I, 12)
            dArr(K, 7) = tArr(Dic.Item(tem), 7): dArr(K, 8) = tArr(Dic.Item(tem), 8): dArr(K, 9) = sArr(I, 15)
        End If
    Next I
    With Sheet3
        .Range("A6:I" & .Range("A65535").End(3).Row + 1).ClearContents
        .Range("A6").Resize(K, 9) = dArr
    End With
End Sub
P/s: Dầu âm là do máy tính chạy ra đừng trừ lương lái máy tội họ ( Có thì cho nghỉ việc :D nhẹ nhẹ vậy thôi...)
Nhấp chuột vào đây để mở rộng...
Ok rồi. Thanks bro nhé. Tính mình hiền lành lắm, diệt cỏ toàn diệt tận gốc thôi =))))
 
Upvote 0
Upvote 0
Lúc đầu e cũng dùng vlookup nhưng file nặng máy chạy chậm nên mới chuyển hết sang code thế này cho nhanh ạ
 
Upvote 0
Bạn ơi. Trog quá trình chạy lại phát sih 1 lỗi, đó là nếu như cột I của sheet "BCHN" nhập hơi nhiều số 0 hoặc là trống nhiều ô dữ liệu thì k chạy được sheet "BCTH" và nó báo lỗi như hình dưới. Vì k phải khi nào mình cũng nhập được hết dữ liệu, mà k nhập hết thì nó lại k chạy đc ra BCTH. Bạn giúp mìh với !upload_2017-8-14_13-54-26.png
 

File đính kèm

  • upload_2017-8-14_13-51-43.png
    upload_2017-8-14_13-51-43.png
    188.9 KB · Đọc: 2
Upvote 0
LightStar252 đã viết:
Bạn ơi. Trog quá trình chạy lại phát sih 1 lỗi, đó là nếu như cột I của sheet "BCHN" nhập hơi nhiều số 0 hoặc là trống nhiều ô dữ liệu thì k chạy được sheet "BCTH" và nó báo lỗi như hình dưới. Vì k phải khi nào mình cũng nhập được hết dữ liệu, mà k nhập hết thì nó lại k chạy đc ra BCTH. Bạn giúp mìh với !View attachment 181523
Nhấp chuột vào đây để mở rộng...
Bạn đính kèm file lỗi lên. Vì lâu quá rồi hiện tại chưa hình dung lại được
 
Upvote 0

File đính kèm

Upvote 0
Với nhờ bạn giúp mình làm cái nút ấn lệnh chạy code Âm dầu với. Thanks bạn nhiều !
 
Upvote 0
LightStar252 đã viết:
Hai trườg hợp trống nhiều ô dữ liệu và có nhiều sô "0" đây, chạy sheet "BCHN" đều bị lỗi Division by zero
Nhấp chuột vào đây để mở rộng...
Cái đó họ nói là biểu thức chia cho số 0. Bạn thử sửa lại như thế này xem
Mã: 
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")
Thang = Month(Sheets("BCTH").Range("G6"))
With Sheets("CSDL")
    tArr = .Range(.Range("B11"), .Range("B65535").End(3)).Resize(, 6).Value
End With
For I = 1 To UBound(tArr, 1)
    Dic.Item(tArr(I, 1)) = I
Next I
With Sheets("BCHN")
    sArr = .Range(.Range("B10"), .Range("B65535").End(3)).Resize(, 15).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 16)
For I = 1 To UBound(sArr, 1)
    If Month(sArr(I, 1)) = Thang Then
        tem = sArr(I, 3)
        If Not Dic.Exists(tem) Then
            K = K + 1
            Dic.Add tem, K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2): dArr(K, 3) = tem
            dArr(K, 4) = tArr(Dic.Item(tem), 5): dArr(K, 5) = tArr(Dic.Item(tem), 6)
            dArr(K, 6) = sArr(I, 8): dArr(K, 7) = sArr(I, 9)
            dArr(K, 10) = sArr(I, 6)
            dArr(K, 16) = sArr(I, 14)
        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), 16) = sArr(I, 14)
            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))
            If dArr(K, 6) <> 0 Then 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")
    .Range("A12:P" & .Range("A65535").End(3).Row + 1).ClearContents
    .Range("A12").Resize(K, 16) = dArr
End With
Set Dic = Nothing
End Sub
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

V
Help: Hàm đếm lọc giá trị trùng (8 người xem)
Trả lời
3
Đọc
13
Phuocam
Phuocam
L
Có ai biết fix lỗi này không ạ (4 người xem)
    • Buồn
Trả lời
0
Đọc
4
lekimhuy0812
L
C
Filter có điều kiện đang ở dạng Cột (3 người xem)
Trả lời
1
Đọc
18
Hoàng Tuấn 868
H
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU (5 người xem)
Trả lời
8
Đọc
88
truongvu317
truongvu317
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng, (3 người xem)
Trả lời
0
Đọc
4
hanhnguyen12022021
H
B
XIN HƯỚNG DẪN CÁCH ĐỂ HÀM XLOOKUP TỰ NHẢY THEO SỐ LƯỢNG DÒNG CỦA ĐIỀU KIỆN KHÔNG SỬ DỤNG VBA
Trả lời
0
Đọc
9
bcttymc
B
tonny jj
Lập hàm thể hiện số công lệnh của ngày đi công tác (1 người xem)
Trả lời
5
Đọc
163
Gà Công Nghệ
Gà Công Nghệ
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
    • Thích
Trả lời
1
Đọc
3K
PhanTuHuong
PhanTuHuong
K
Lỗi cấu trúc hình ảnh khi mở file bằng điện thoại
Trả lời
0
Đọc
23
Kecodonlalala
K
N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình (1 người xem)
    • Cảm ơn
    • Thích
Trả lời
7
Đọc
134
newbiexo
N
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
3
Đọc
59
Nguyễn Duy Tuân
Nguyễn Duy Tuân
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application
    • Thích
Trả lời
2
Đọc
130
Nguyễn Duy Tuân
Nguyễn Duy Tuân
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :) (1 người xem)
    • Thích
    • Yêu thích
Trả lời
7
Đọc
325
PhanTuHuong
PhanTuHuong
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025 (1 người xem)
    • Thích
    • Yêu thích
Trả lời
1
Đọc
62
PhanTuHuong
PhanTuHuong
DinhManh1307
Cách thống kê công việc sản xuất từng người để tính lương sản phẩm
Trả lời
8
Đọc
185
thuytrangbp28
T
K
Làm sao để ô excel hiển thị tên nhưng khi nhấp vào thì đó là công thức
Trả lời
1
Đọc
43
pycckuu410
P
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
41
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
25K
pycckuu410
P
V
  • Question Question
Đếm xếp loại của đơn hàng
Trả lời
8
Đọc
210
vanlinh_2904
V
J
Công thức tính lương khi mỗi tháng tăng lương cơ bản (1 người xem)
Trả lời
2
Đọc
75
jangne88
J
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom