Chuyên mục xử lý, gỡ rối code VBA (2 người xem)

Liên hệ QC

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

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

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
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.
Có ai không?
 
Upvote 0
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
Xem kết quả mẫu mà vẫn không hiểu dữ liệu kết quả từ đâu có.
Nếu chỉ tìm mã thì được 5 mã:
KE07.N ----------200
KE03.O ----------1000
KE03.TAY ----------1000
KE07.N -----------150
KEEX07.TS -----------192
 
Upvote 0
Xem kết quả mẫu mà vẫn không hiểu dữ liệu kết quả từ đâu có.
Nếu chỉ tìm mã thì được 5 mã:
KE07.N ----------200
KE03.O ----------1000
KE03.TAY ----------1000
KE07.N -----------150
KEEX07.TS -----------192
File của em nặng quá không tải lên được, dữ liệu thì lấy ở 5 sheet khác nhưng chỉ có dữ liệu trung ở 3 sheet em nói ở trên. Hiện tại thì mỗi lần chạy xong là em phải chạy thêm 1 macro để lọc dữ liệu trùng nữa nên hơi mất thời gian nên em muốn viết thêm vào phần lấy dữ liệu để chạy 1 lần là có kết quả luôn. Anh có mail không em gửi qua mail cho anh để xem cho rõ hơn.
 
Upvote 0
Xem kết quả mẫu mà vẫn không hiểu dữ liệu kết quả từ đâu có.
Nếu chỉ tìm mã thì được 5 mã:
KE07.N ----------200
KE03.O ----------1000
KE03.TAY ----------1000
KE07.N -----------150
KEEX07.TS -----------192
Anh ơi, anh xem hộ em file đính kèm, hiện tại ở cột mã vật tư có 2 mã là KEEX03_MDO là trùng nhau, bây giờ em muốn xóa dòng KEEX03_MDO có mã bề mặt là "_" thì làm thế nào ạ. Em cảm ơn.
 

File đính kèm

Upvote 0
tôi có vòng lặp

PHP:
sub news()
'
If vianboolean = True Then Exit Sub

' code

Application.OnTime Now + TimeValue("00:10:00"), "News"
end sub

và button thay đổi trạng thái

PHP:
Private Sub CommandButton1_Click()
vianboolean = True
ens sub

button gọi marco chạy lại

PHP:
Sub viannews()
vianboolean = False
Call News
End Sub

Vấn đề ở đây là macro của tôi sẽ bị lỗi nếu như tôi chạy sub viannews trước khi sub news trước bị exit thì nó chạy 2 cái sub song song, cái này giải quyết như thế nào mọi người giúp tôi với!!![/PHP]
 
Upvote 0
Mình tham khảo một đoạn codec của một bạn cao thủ trên diễn đàn rồi xào lại nhưng lại bị lỗi ở dòng If data1(i, 2).Value = data2(1, 1).Value Then mà mình không hiểu vì sao, mong mọi người giải thích giúp. Cảm ơn mọi người!
Sub DropDown1_Change()
Dim data(), data1()
Dim data2()
data2 = Sheet2.Range("P6:Q6").Value
iR = Sheet1.Range("D" & Rows.Count).End(xlUp).Row
If iR < 4 Then Exit Sub
data = Sheet1.Range("B5:M" & iR).Value
iR = UBound(data, 1)
ReDim data1(1 To iR, 1 To 12)
For i = 1 To iR
If data1(i, 2).Value = data2(1, 1).Value Then
Sheet1.Range("B" & i & ":M" & i).Value = data1()
End If
Sheet2.Range("B" & i & ":M" & i).Value = data1()
Next i
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Upvote 0
Mình tham khảo một đoạn codec của một bạn cao thủ trên diễn đàn rồi xào lại nhưng lại bị lỗi ở dòng If data1(i, 2).Value = data2(1, 1).Value Then mà mình không hiểu vì sao, mong mọi người giải thích giúp. Cảm ơn mọi người!
PHP:
 Sub DropDown1_Change()
     ' . . . . . . . . . '
 End Sub

Thường thì các macro tác dụng lên trang tính nào đó; & macro này của bạn cũng không ngoại lệ
Nhưng bạn chưa đưa trang tính lên thì bạn giống như bảo mọi người làm thầy bói rồi còn gì?

 
Upvote 0
Bỏ .Value đi thì hết lỗi dòng đó nhưng mấy dòng dưới lỗi tiếp...

Mình cần tìm hiểu và nắm chắc căn bản đã.
Từ cách dùng biến, điều khiển đối tượng Range (thuộc tính, phương thức), rồi đến Array.

Đọc tạm bài #4-6-10.

Cần học cách cẩn thận với từ ngữ trước đã. Chỉ riêng có từ "code" mà cũng không biết đánh vần thì căn bản quái gì nữa.
Mình tham khảo một đoạn codec của một bạn cao thủ trên diễn đàn rồi xào lại ...
 
Upvote 0
Mình tham khảo một đoạn code của 1 cao thủ trên diễn đàn rồi xào lại nhưng lại bị lỗi ở dòng If data1(i, 2).Value = data2(1, 1).Value Then
mà mình không hiểu vì sao, mong mọi người giải thích giúp.
PHP:
Sub DropDown1_Change()
 Dim data(), data1(), data2()

 data2 = Sheet2.Range("P6:Q6").Value
 iR = Sheet1.Range("D" & Rows.Count).End(xlUp).Row
 If iR < 4 Then Exit Sub
 data = Sheet1.Range("B5:M" & iR).Value
 iR = UBound(data, 1)
 ReDim data1(1 To iR, 1 To 12)
 For i = 1 To iR
    If data1(i, 2).Value = data2(1, 1).Value Then
      Sheet1.Range("B" & i & ":M" & i).Value = data1()
    End If
    Sheet2.Range("B" & i & ":M" & i).Value = data1()
 Next i
End Sub
Thứ nhất: Bạn chưa cho biết nó báo lỗi như thế nào?
Hình như bạn chưa nạp dữ liệu cho mảng data1() mà, fải không? Vậy làm sao thỏa câu lệnh đó được?
 
Upvote 0
Thứ nhất: Bạn chưa cho biết nó báo lỗi như thế nào?
Hình như bạn chưa nạp dữ liệu cho mảng data1() mà, fải không? Vậy làm sao thỏa câu lệnh đó được?

Như bài #1320 đã nêu ra, đoạn code ấy sai nhiều lắm, về cả thuật toán lẫn thuật ngữ.
Thuật ngữ:
data1(i,2).Value là thuật ngữ truy vấn thuộc tính Value của phần tử dòng i, cột 2 của mảng data1
Mảng data1 là mảng 2 chiều. Vì không được xác định kiểu cho nên phần tử data1(i,2) sẽ có kiểu Variant. Vì chưa gán trị cho nên VBA chưa xác định được kiểu của nó sẽ có thuộc tính Value hay không.
Thuật toán:
như bạn đã nêu ra, data1 chưa được gán trị cho nên đem nó ra so sánh chả có nghĩa lý gì cả.
 
Upvote 0
Hiện tại em có 2 file excel, em muốn copy mã nhân viên và tên nhân viên từ file PXKhoan_2017 sang file PXKhoan_Test thì làm thế nào ạ. Và cho em hỏi là có cách nào copy mà không cần mở file không ạ. Em cảm ơn.
 

File đính kèm

Upvote 0
Em có dữ liệu dạng aaxbbbW trong đó 2 chữ màu đỏ là không đổi, aa, bbb là số (có thể là 1x18W, 10x200W). Kết quả em cần là tích của 2 số aa và bbb
Trong excel thì em dùng hàm FIND để tìm vị trí của x W rồi từ đó dùng hàm MID, LEFT, RIGHT để tách các số ra.

Chuyển sang VBA thì phương thức tìm kiếm FIND trong VBA lại không như trong excel. Các bác trợ giúp em trường hợp này với
 
Upvote 0
Bạn xài hàm tự tạo này:
PHP:
Function Tich(StrC As String) As Double
 Dim VTr As Byte, GPE As Double, COM As Double

 VTr = InStr(StrC, "x")
 If VTr Then
    GPE = CDbl(Left(StrC, VTr - 1))
    StrC = Mid(StrC, VTr + 1, Len(StrC))
    COM = CDbl(Left(StrC, Len(StrC) - 1))
    Tich = GPE * COM
 End If
End Function

Tich(25.5x13.5W) => 334.25
 
Upvote 0
Chắc bạn copy từ sheet BangLuong & Paste vào sheet đó luôn hả?
Mã:
Public Sub GPE_()
Dim cn As Object, Str, Path As String
Path = ThisWorkbook.Path & "\PXKhoan_201712.xlsx"
Set cn = CreateObject("ADODB.Connection")
Str = "Select * from [BangLuong$B5:C] where f1 is not null"
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Path & ";Extended Properties=""Excel 12.0;HDR=No"";"
Sheets("BangLuong").Range("B5").CopyFromRecordset cn.Execute(Str)
End Sub
Vâng anh, copy mã nhân viên và tên nhân viên từ sheet BangLuong của PXKhoang_2017 vào sheet BangLuong của PXKhoan_Test. À anh cho em hỏi thêm là, bây giờ em có 10 file của mỗi phân xưởng riêng thì có cách nào chạy 1 lần mà tự động copy theo từng phân xưởng không anh. Hiện tại mỗi phân xưởng nằm cùng một thư mục quản lý và chia ra từng thư mục theo phân xưởng. Có một vấn đề nữa là 2 file cần copy dữ liệu không nằm trong một thư mục, như hình ở dưới thì dữ liệu cần copy nằm trong các phân xưởng, còn file để paste dữ liệu thì nằm trong thư mục Templates anh ạ.
Capturef.png
 
Lần chỉnh sửa cuối:
Upvote 0
Em chào mọi người!
Nhờ mọi người giải đáp giúp em thắc mắc này ạ!
Em có một bảng dữ liệu muốn dùng lệnh auto sort theo thứ tự tăng dần. Em dùng code bên dưới.
Giá trị cột B em cần sort vlookup từ sheet khác, sẽ thay đổi theo thời gian chứ em không tự nhập tay giá trị này trực tiếp vào B.

Tuy nhiên em gặp vấn đề là khi giá trị cột B thay đổi thì code không chạy. Chỉ khi nào em nhấp chuột hoặc bấm enter hay nhập trực tiếp vào một ô bất kỳ ở cột B thì code mới chạy sort lại theo đúng thứ tự.

Vậy em làm cách nào để chỉ cần thay đổi giá trị ở bảng mà cột B vlookup qua thì code chạy luôn chứ không cần em bấm chuột vào cột B ạ?

Mong mọi người chỉ giáo giúp em với!!!!
Em cảm ơn ạ!!!!!!!

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Range("B1").Sort Key1:=Range("B2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End
 
Upvote 0
Sếp nào vô lý thế. Sao phải "ma cà rồng". Tôi làm sao là việc của tôi miễn xong việc là được... (Sếp có trên GPE không? mời vào đây tiếp chuyện.)
Sếp của em thì không có ở trên này anh ạ, bởi vì cái này hàng tháng em đều phải copy 1 lần. Sau khi copy xong thì có đoạn macro đẩy kế hoạch cho các phân xưởng nữa nên làm tự động thì hay hơn ạ.
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

Back
Top Bottom