Chuyên mục xử lý, gỡ rối 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)
Status
Không mở trả lời sau này.
ndu96081631

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,957
Sắp xếp theo thời gian sắp xếp theo bầu chọn
hongtrang26 đã viết:
Hôm trước mình được bạn befaint trợ giúp code phân bổ theo điều kiện nhưng nó bị lỗi khi dữ liệu không sắp xếp theo trình tự.
Mình có nhờ chỉnh lại nhưng không được. Mình đã tự mò và thử chỉnh lại.
code chạy ra đúng kết quả, nhưng khi dữ liệu mình nên khoảng 3.000 dòng thì code chạy mất khoảng 30s.
Mọi người xem giúp mình xem code mình cần thêm gì để có thể chạy nhanh hơn không
Mã: 
Sub Phan_Bo1()
    Dim a(), lRow As Long, sMatch As String, eMatch As String
    Dim Res(), TT As Double, KH As Double, i As Long, j As Long
   
    With Sheet5
        lRow = .Range("A" & Rows.Count).End(xlUp).Row
        a = .Range("A7:S" & lRow).Value
        lRow = UBound(a, 1)
        ReDim Res(1 To lRow, 1 To 1)
        For i = 1 To lRow
         
            sMatch = a(i, 1) & "#" & a(i, 2) & "#" & a(i, 3) & "#" & a(i, 4) & "#" & a(i, 5)
            TT = 0: KH = 0
            'Xac dinh so Tieu_thu
            For j = 1 To lRow
                eMatch = a(j, 1) & "#" & a(j, 2) & "#" & a(j, 3) & "#" & a(j, 4) & "#" & a(j, 5)
                If sMatch = eMatch Then TT = TT + a(j, 18)
             
            Next j
            'Xac dinh so Ke_hoach
            For j = 1 To lRow
                eMatch = a(j, 1) & "#" & a(j, 2) & "#" & a(j, 3) & "#" & a(j, 4) & "#" & a(j, 5)
                If sMatch = eMatch Then KH = KH + a(j, 19)
             
            Next j
            'Tinh Phan_bo
            Res(i, 1) = a(i, 19) * TT / KH
        Next i
        .Range("U7").ClearContents
        .Range("U7").Resize(lRow, 1) = Res
    End With
End Sub
Nhấp chuột vào đây để mở rộng...
Tôi chỉ nhìn công thức cột T để viết thôi nhé, Tốc độ thì không có dữ liệu nênkhông biết được.
PHP: 
Public Sub S_GPE()
Dim sArr(), dArr(), tArr(), I As Long, K As Long, R As Long, Tem As String, Rws As Double
sArr = Range("A7", Range("A7").End(xlDown)).Resize(, 19).Value
R = UBound(sArr)
ReDim tArr(1 To R, 1 To 2)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
For I = 1 To R
    Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 4) & "#" & sArr(I, 5)
    If Not .Exists(Tem) Then
        K = K + 1
        .Item(Tem) = K
        tArr(K, 1) = sArr(I, 18)
    End If
        Rws = .Item(Tem)
        tArr(Rws, 2) = tArr(Rws, 2) + sArr(I, 19)
Next I
    For I = 1 To R
        Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 4) & "#" & sArr(I, 5)
        Rws = .Item(Tem)
        dArr(I, 1) = tArr(Rws, 1) / tArr(Rws, 2) * sArr(I, 19)
    Next I
End With
Range("Y7").Resize(R) = dArr
End Sub
 
Upvote 0
Ba Tê đã viết:
Tôi chỉ nhìn công thức cột T để viết thôi nhé, Tốc độ thì không có dữ liệu nênkhông biết được.
PHP: 
Public Sub S_GPE()
Dim sArr(), dArr(), tArr(), I As Long, K As Long, R As Long, Tem As String, Rws As Double
sArr = Range("A7", Range("A7").End(xlDown)).Resize(, 19).Value
R = UBound(sArr)
ReDim tArr(1 To R, 1 To 2)
ReDim dArr(1 To R, 1 To 1)
With CreateObject("Scripting.Dictionary")
For I = 1 To R
    Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 4) & "#" & sArr(I, 5)
    If Not .Exists(Tem) Then
        K = K + 1
        .Item(Tem) = K
        tArr(K, 1) = sArr(I, 18)
    End If
        Rws = .Item(Tem)
        tArr(Rws, 2) = tArr(Rws, 2) + sArr(I, 19)
Next I
    For I = 1 To R
        Tem = sArr(I, 1) & "#" & sArr(I, 2) & "#" & sArr(I, 4) & "#" & sArr(I, 5)
        Rws = .Item(Tem)
        dArr(I, 1) = tArr(Rws, 1) / tArr(Rws, 2) * sArr(I, 19)
    Next I
End With
Range("Y7").Resize(R) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Cám ơn bạn nhiều, tốc độ khi dữ liệu lên đến 3000 dòng vẫn rất nhanh
 
Upvote 0
Nhờ ae xem giúp code, khi chạy macro "lấy dutoan" ở file sau bị lỗi runtime error9
 

File đính kèm

Upvote 0
duytmd đã viết:
Nhờ ae xem giúp code, khi chạy macro "lấy dutoan" ở file sau bị lỗi runtime error9
Nhấp chuột vào đây để mở rộng...
With Sheets("KHOILUONG")
Chẳng có sheet nào tên "KHOILUONG".
Kinh nghiệm đặt tên sheet không nên có dấu cách và dấu tiếng Việt. Muốn dễ nhìn thì nên là "KHOI_LUONG"
 
Upvote 0
Nói chung ít người tạo pivot bằng macro. vì việc này tuy quan trọng nhưng ít phải làm mới.
Nếu bạn thêm dòng ở bảng gốc mà pivot không cho thêm vô thì có thể chọn lại vùng dữ liệu.

Khi RUN macro, nó tạo mới pivot và vẫn mang tên cũ nên lỗi
 
Upvote 0
Nhờ các bạn xem cho mình cái Code: Worksheet_Change ,ko biết nó còn thiếu cái gì mà nó ko hoạt động ?
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
If [D1] = 0 Then
CommandButton1.Visible = False
Exit Sub
End If
If [D1] >= 0 Then
CommandButton1.Visible = True
Exit Sub
End If
If [G1] = 0 Then
CommandButton2.Visible = False
Exit Sub
End If
If [G1] >= 0 Then
CommandButton2.Visible = True
Exit Sub
End If
End Sub
 
Upvote 0
Thấy bạn befaint có trả lời bằng một dấu ? chắc là bạn ấy ko hiểu câu hỏi của mình hoặc là một lý do nào khác...?
LDo.jpg
Câu hỏi của mình là:
1, Khi tại ô D1 có dữ liệu bằng không ,thì nút CommandButton1 sẽ bị ẨN và ngược lại....Nếu chỉ sử dụng đoạn Code này thì nó hoạt động bình thường.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
If [D1] = 0 Then
CommandButton1.Visible = False
Exit Sub
End If
If [D1] >= 0 Then
CommandButton1.Visible = True
Exit Sub
End If
End Sub
2, Mình thêm một điều kiện thứ hai là: Khi tại ô G1 có dữ liệu bằng không ,thì nút CommandButton2 sẽ bị ẨN và ngược lại....Thì Code ko hoạt động.
 
Upvote 0
Do Nam Trung đã viết:
Thấy bạn befaint có trả lời bằng một dấu ? chắc là bạn ấy ko hiểu câu hỏi của mình hoặc là một lý do nào khác...?
View attachment 187407
Câu hỏi của mình là:
1, Khi tại ô D1 có dữ liệu bằng không ,thì nút CommandButton1 sẽ bị ẨN và ngược lại....Nếu chỉ sử dụng đoạn Code này thì nó hoạt động bình thường.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
If [D1] = 0 Then
CommandButton1.Visible = False
Exit Sub
End If
If [D1] >= 0 Then
CommandButton1.Visible = True
Exit Sub
End If
End Sub
2, Mình thêm một điều kiện thứ hai là: Khi tại ô G1 có dữ liệu bằng không ,thì nút CommandButton2 sẽ bị ẨN và ngược lại....Thì Code ko hoạt động.
Nhấp chuột vào đây để mở rộng...
Vậy sửa lại thế này xem sao.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
If [D1] = 0 Then
              CommandButton1.Visible = False
Else
              CommandButton1.Visible = True
End If
If [G1] = 0 Then
             CommandButton2.Visible = False
Else
             CommandButton2.Visible = True
End If
End Sub
 
Upvote 0
giaiphap đã viết:
Vậy sửa lại thế này xem sao.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
If [D1] = 0 Then
              CommandButton1.Visible = False
Else
              CommandButton1.Visible = True
End If
If [G1] = 0 Then
             CommandButton2.Visible = False
Else
             CommandButton2.Visible = True
End If
End Sub
Nhấp chuột vào đây để mở rộng...

CommandButton1.Visible = CBool([D1]) , hoặc là
CommandButton1.Visible = ([D1] <> 0)
 
Upvote 0
VetMini đã viết:
CommandButton1.Visible = CBool([D1]) , hoặc là
CommandButton1.Visible = ([D1] <> 0)
Nhấp chuột vào đây để mở rộng...
Code của bạn ngắn gọn ,chạy Ok ,Nhưng nếu 2 nút CommandButton mà dùng chung một điều kiện tại D1 ,Tức là khi tại D1 có dữ liệu thì
CommandButton1 sẽ ẨN và CommandButton2 sẽ HIỆN ....Nên sửa Code lại như thế nào ?
 
Upvote 0
Do Nam Trung đã viết:
Code của bạn ngắn gọn ,chạy Ok ,Nhưng nếu 2 nút CommandButton mà dùng chung một điều kiện tại D1 ,Tức là khi tại D1 có dữ liệu thì
CommandButton1 sẽ ẨN và CommandButton2 sẽ HIỆN ....Nên sửa Code lại như thế nào ?
Nhấp chuột vào đây để mở rộng...

CommandButton1.Visible = ([D1] <> 0)
CommandButton2.Visible = Not CommandButton1.Visible
 
Upvote 0
Nhờ AE chỉnh sửa hoặc thêm code (code này mình tìm được trên diền đàn)
1. Hiện tại code không lấy được dữ liệu bên sheet CSDL DM ở cột D nếu có dấu = ở trước.
2. Nếu bổ dầu bằng thì lấy được dữ liệu nhưng ở cột G lại thiếu dấu = để chạy công thức. nhờ ae xem giúp.
 

File đính kèm

Upvote 0
duytmd đã viết:
Nhờ AE chỉnh sửa hoặc thêm code (code này mình tìm được trên diền đàn)
1. Hiện tại code không lấy được dữ liệu bên sheet CSDL DM ở cột D nếu có dấu = ở trước.
2. Nếu bổ dầu bằng thì lấy được dữ liệu nhưng ở cột G lại thiếu dấu = để chạy công thức. nhờ ae xem giúp.
Nhấp chuột vào đây để mở rộng...
Bạn lấy dạng Range("xxx").Formula xem sao
Mình thử với ô G9 của Sheets("xuatDL")
PHP: 
Sub Thu()
    With Sheets("xuatDL")
        MsgBox .Range("G9").Formula
    End With
End Sub
 
Upvote 0
Anh(chị) cho em hỏi, em có 1000 dòng trong sheet 1 và sheet2 để nhập sang sheet 3, nhưng có một số dữ liệu trùng lặp giữa sheet 1 và sheet 2 em không muốn nhập thì có hàm nào là bỏ qua các dữ liệu trung lặp không ạ. Em cảm ơn.
 
Upvote 0
thanhnt1910 đã viết:
Anh(chị) cho em hỏi, em có 1000 dòng trong sheet 1 và sheet2 để nhập sang sheet 3, nhưng có một số dữ liệu trùng lặp giữa sheet 1 và sheet 2 em không muốn nhập thì có hàm nào là bỏ qua các dữ liệu trung lặp không ạ. Em cảm ơn.
Nhấp chuột vào đây để mở rộng...
Xét trùng trong 1 cột hay trùng bao nhiêu cột mới coi là trùng?
Bạn đưa file ví dụ lên, mỗi sheet vài chục dòng có trùng và không trùng, tạo mẫu bảng kết quả muốn có cho mọi người hiểu bạn muốn gì.
 
Upvote 0
Ba Tê đã viết:
Xét trùng trong 1 cột hay trùng bao nhiêu cột mới coi là trùng?
Bạn đưa file ví dụ lên, mỗi sheet vài chục dòng có trùng và không trùng, tạo mẫu bảng kết quả muốn có cho mọi người hiểu bạn muốn gì.
Nhấp chuột vào đây để mở rộng...
Dữ liệu được thêm vào sheet TonVatTu, lấy dữ liệu từ 3 sheet BTP1, Son_PX1, Son_cty. Dữ liệu trong sheet Son_PX1 trùng mã vật tư với sheet BTP1 và cột Sơn tím thuộc sheet Son_PX1 trùng với cột BTP2.7S1 trong sheet BTP1 thì sẽ lấy dữ liệu trong sheet Son_PX1. Tương tự trong sheet Son_cty nếu trùng như thế thì sẽ lấy dữ liệu trong sheet Son_cty và bỏ qua dữ liệu trong sheet BTP1 ạ.

PHP: 
 ' LAY SO LIEU SHEET BTP1
 wsBTP1.Select
    Cells(csHangTieuDe, csCotMaVatTu).End(xlDown).Select
    intSoLuongHang = ActiveCell.Row - csHangTieuDe

    Cells(csHangTieuDe, csCotBatDauChuyen).End(xlToRight).Select
    intSoLuongCot = ActiveCell.Column - csCotBatDauChuyen + 1

    For H = 0 To intSoLuongHang - 1
        For C = 0 To intSoLuongCot - 1

            Set rgDuLieu = Cells(csHangTieuDe + 1 + H, csCotBatDauChuyen + C)

            If (rgDuLieu.Value <> 0) Then
                intCount = intCount + 1

                rgTieuDe_NgayChot.Offset(intCount, 0).Value = NgayChot

                MaBeMat = "_"
                rgTieuDe_MaBeMat.Offset(intCount, 0).Value = MaBeMat

                ' Chuyen doi ma Phoi sang ma chi tiet thuong
                MaVatTu = Cells(rgDuLieu.Row(), csCotMaVatTu)
                MaKho = Cells(csHangTieuDe, rgDuLieu.Column())

                Call DieuChinhMa(MaVatTu, "", MaKho, MaVatTuDC, "", MaKhoDC)
                rgTieuDe_MaVatTu.Offset(intCount, 0).Value = MaVatTuDC
                rgTieuDe_MaKho.Offset(intCount, 0).Value = MaKhoDC

                ' So luong
                DonVi = Cells(rgDuLieu.Row(), csCotDonVi)
                SoLuong = rgDuLieu.Value
                If SoLuong < 0 Then
                    MsgBox ("Bang BTP1, kiem tra lai ma " & MaVatTu & " tai kho " & MaKho & " bi am " & SoLuong)
                End If
                If DonVi <> "kg" Then
                    rgTieuDe_SoLuong.Offset(intCount, 0).Value = SoLuong
                Else
                    'Quy doi so luong
                    rgTieuDe_SoLuong.Offset(intCount, 0).Value = QuyDoiVatTuTuKgSangCai(MaVatTu, SoLuong)
                End If
            End If
NextC1:
    Next C
NextH1:
    Next H

     ' LAY SO LIEU SHEET Son_Cty
         
    wsSonMaCty.Select
    Cells(csHangTieuDe, csCotMaVatTu).End(xlDown).Select
    intSoLuongHang = ActiveCell.Row - csHangTieuDe

    Cells(csHangTieuDe, csCotBatDauChuyen).End(xlToRight).Select
    intSoLuongCot = ActiveCell.Column - csCotBatDauChuyen + 1

    For H = 0 To intSoLuongHang - 1
        For C = 0 To intSoLuongCot - 1

            Set rgDuLieu = Cells(csHangTieuDe + 1 + H, csCotBatDauChuyen + C)

            If (rgDuLieu.Value <> 0) Then
                intCount = intCount + 1

                rgTieuDe_NgayChot.Offset(intCount, 0).Value = NgayChot

                MaVatTu = Cells(rgDuLieu.Row(), csCotMaVatTu)
                ' DOI TEN BE MAT SANG MA BE MAT
                MaBeMat = WorksheetFunction.VLookup(Cells(csHangTieuDe, rgDuLieu.Column()), tblMaBeMatChiTiet, 2, 0)
                MaKho = csMaKhoSonCty

                ' Chuyen doi ma Phoi sang ma chi tiet thuong
                Call DieuChinhMa(MaVatTu, MaBeMat, MaKho, MaVatTuDC, MaBeMatDC, MaKhoDC)
                rgTieuDe_MaVatTu.Offset(intCount, 0).Value = MaVatTuDC
                rgTieuDe_MaBeMat.Offset(intCount, 0).Value = MaBeMatDC
                rgTieuDe_MaKho.Offset(intCount, 0).Value = MaKhoDC

                ' So luong
                DonVi = Cells(rgDuLieu.Row(), csCotDonVi)
                SoLuong = rgDuLieu.Value
                If SoLuong < 0 Then
                    MsgBox ("Bang Son_Cty, kiem tra lai ma " & MaVatTu & "-" & MaBeMat & " tai kho " & MaKho & " bi am " & SoLuong)
                End If
                If DonVi <> "kg" Then
                    rgTieuDe_SoLuong.Offset(intCount, 0).Value = SoLuong
                Else
                    'Quy doi so luong
                    rgTieuDe_SoLuong.Offset(intCount, 0).Value = QuyDoiVatTuTuKgSangCai(MaVatTu, SoLuong)
                End If

            End If
NextC3:
    Next C
NextH3:
    Next H


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' LAY SO LIEU SHEET Son_PX1   
    wsSonMaPX1.Select
    Cells(csHangTieuDe, csCotMaVatTu).End(xlDown).Select
    intSoLuongHang = ActiveCell.Row - csHangTieuDe

    Cells(csHangTieuDe, csCotBatDauChuyen).End(xlToRight).Select
    intSoLuongCot = ActiveCell.Column - csCotBatDauChuyen + 1

    For H = 0 To intSoLuongHang - 1
        For C = 0 To intSoLuongCot - 1

            Set rgDuLieu = Cells(csHangTieuDe + 1 + H, csCotBatDauChuyen + C)

            If (rgDuLieu.Value <> 0) Then
                intCount = intCount + 1

                rgTieuDe_NgayChot.Offset(intCount, 0).Value = NgayChot

                MaVatTu = Cells(rgDuLieu.Row(), csCotMaVatTu)
                ' DOI TEN BE MAT SANG MA BE MAT
                MaBeMat = WorksheetFunction.VLookup(Cells(csHangTieuDe, rgDuLieu.Column()), tblMaBeMatChiTiet, 2, 0)
                MaKho = csMaKhoSonPX1

                ' Chuyen doi ma Phoi sang ma chi tiet thuong
                Call DieuChinhMa(MaVatTu, MaBeMat, MaKho, MaVatTuDC, MaBeMatDC, MaKhoDC)
                rgTieuDe_MaVatTu.Offset(intCount, 0).Value = MaVatTuDC
                rgTieuDe_MaBeMat.Offset(intCount, 0).Value = MaBeMatDC
                rgTieuDe_MaKho.Offset(intCount, 0).Value = MaKhoDC

                ' So luong
                DonVi = Cells(rgDuLieu.Row(), csCotDonVi)
                SoLuong = rgDuLieu.Value
                If SoLuong < 0 Then
                    MsgBox ("Bang Son_PX1, kiem tra lai ma " & MaVatTu & "-" & MaBeMat & " tai kho " & MaKho & " bi am " & SoLuong)
                End If
                If DonVi <> "kg" Then
                    rgTieuDe_SoLuong.Offset(intCount, 0).Value = SoLuong
                Else
                    'Quy doi so luong
                    rgTieuDe_SoLuong.Offset(intCount, 0).Value = QuyDoiVatTuTuKgSangCai(MaVatTu, SoLuong)
                End If

            End If
NextC4:
    Next C
NextH4:
    Next H
 

File đính kèm

Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

H
Quản Lý Công Văn đi Và đến (1 người xem)
9 10 11
Trả lời
214
Đọc
158K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
51
VetMini
V
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước. (2 người xem)
Trả lời
2
Đọc
42
hanhnguyen12022021
H
S
RemoveDuplicates Adodb VBA (2 người xem)
Trả lời
0
Đọc
48
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT (1 người xem)
Trả lời
0
Đọc
81
giaoluu1231
G
N
Không chạy được file VBA (2 người xem)
Trả lời
1
Đọc
49
yaaasoo01
Y
sangvanng92
  • Question Question
Phân quyền user truy cập (1 người xem)
Trả lời
9
Đọc
155
Hoàng Tuấn 868
H
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
7
Đọc
136
DinhManh1307
DinhManh1307
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
6
Đọc
294
tranhungdao12a3
T
GPE-Trợ Lý
[GPE] TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365 (1 người xem)
Trả lời
0
Đọc
678
GPE-Trợ Lý
GPE-Trợ Lý
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
36 37 38
Trả lời
759
Đọc
49K
befaint
befaint
H
Quên mật khẩu khóa protect
Trả lời
18
Đọc
258
HeSanbi
HeSanbi
T
  • Question Question
Tìm này không xuất hiện trong khoảng thời gian
Trả lời
7
Đọc
105
tuan16
T
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
5
Đọc
186
befaint
befaint
nghiahandsome1995
Xin mã code autofit
Trả lời
4
Đọc
143
yaaasoo01
Y
tuankieu28
Hỗ trợ sửa hàm tìm thông tin
Trả lời
1
Đọc
44
thuytrangbp28
T
N
Cho em xin hỏi về hàm Workday về ngày làm bù ạ (1 người xem)
Trả lời
3
Đọc
93
hoangtuaotrang_hp_vn
H
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
324
Đọc
24K
vanthuan986
V
T
Bảng tính trợ cấp theo Nghị định 178 và tính lương hưu
    • Thích
Trả lời
10
Đọc
1K
trung_bhxh
T
D
Chuyển đổi font chữ VNI-Time.
    • Cười
Trả lời
6
Đọc
495
vanle33
vanle33
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