Chuyên mục xử lý, gỡ rối code VBA

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

Ba Tê · 5/11/17

huongmuine đã viết:
Cảm ơn Thầy.
Nhờ Thầy có thể viết giúp đoạn code với ạ. ( Code sẽ xử lý trên các cột tô màu vàng )
Xin cảm ơn Thầy nhiều.

Cột B không biết! Cột V (Nam) là thừa (Tốn công thức) trong khi cột U ghi "x" là Nữ, để trống đã biết là Nam.
Tôi có chèn thêm 1 dòng 2, dữ liệu từ dòng 3.

PHP:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, R As Long, Txt As String
Txt = "'11-14"
sArr = Range("M3", Range("M3").End(xlDown)).Resize(, 35).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 24) <> Empty Then
        If sArr(I, 24) = "HTCHTH" Then
            dArr(I, 1) = "HT" & sArr(I, 25)
        ElseIf sArr(I, 27) <> Empty Or sArr(I, 28) <> Empty Then
            dArr(I, 1) = "CDi-BHo"
        Else
            dArr(I, 1) = Left(sArr(I, 24), 1)
        End If
    End If
    dArr(I, 2) = Txt             '<--------------Cột B?'
    dArr(I, 3) = IIf(sArr(I, 31) <> Empty, sArr(I, 31), "/")
Next I
Range("A3").Resize(R, 3) = dArr
End Sub

huongmuine · 5/11/17

Ba Tê đã viết:

Cột B không biết!

PHP:

Public Sub GPE()
Dim sArr(), dArr(), I As Long, R As Long, Txt As String
Txt = "'11-14"
sArr = Range("M3", Range("M3").End(xlDown)).Resize(, 35).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 24) <> Empty Then
        If sArr(I, 24) = "HTCHTH" Then
            dArr(I, 1) = "HT" & sArr(I, 25)
        ElseIf sArr(I, 27) <> Empty Or sArr(I, 28) <> Empty Then
            dArr(I, 1) = "CDi-BHo"
        Else
            dArr(I, 1) = Left(sArr(I, 24), 1)
        End If
    End If
    dArr(I, 2) = Txt             '<--------------Cột B?'
    dArr(I, 3) = IIf(sArr(I, 31) <> Empty, sArr(I, 31), "/")
Next I
Range("A3").Resize(R, 3) = dArr
End Sub

Do vội quá nên nhầm mong thầy thông cảm.
Cột B dùng để tính độ tuổi 11-14 tuổi còn đang học.
Cách tính: lấy năm hiện tại - năm (cột S ). Nếu kết quả bằng hoặc lớn hơn 11 cùng với điều kiện ký tự đầu tiên bên trái cột AJ nhỏ hơn hoặc bằng 5 sẽ ghi ở cột B là 11-14
Cảm ơn thầy nhiều ạ.

tiendungnst · 6/11/17

Ba Tê đã viết:
Thử xem file này coi có đúng ý bạn không.

Dạ đúng rồi ạ, e cảm ơn bác nhiều, nhưng e xin phép được nhờ thêm tí nữa ạ!
Hiện giờ dữ liệu ở M6 chỉ có thể được nhập khi có đủ điều kiện ở K6 là "CHUYỂN ĐƠN"
E muốn nó copy và lặp lại ở tất cả các dòng khi Em sử dụng nút thêm dòng để chèn thêm dòng trong bản tính, để tất cả các dòng chèn thêm đều đáp ứng được yêu cầu cầu tương ứng cho cột M khi có dữ liệu "CHUYỂN ĐƠN" ở cột K được ko ạ?

thanhnt1910 · 6/11/17

Cho em hỏi, hiện tại em có 2 sheet, sheet1 là BQ_Mau và sheet2 là BQ_KMau em lấy được dữ liệu vào một sheet thứ 3 rồi, nhưng trong 2 sheet cần lấy dữ liệu có dữ liệu trùng nhau. Em có viết một đoạn code để lọc dữ liệu mà khi chạy thì tất cả tên ở sheet2 đều giống nhau nhưng vẫn chưa lọc được. Mọi người xem và gợi ý giúp em cách sửa code với ạ. Em cảm ơn.
Đây là đoạn code lấy dữ liệu ở sheet2.

PHP:

Dim shBQMau As Worksheet
    Dim shBQKMau As Worksheet
    Dim j As Long
    Dim i As Long
    Dim LastRowBQMau As Long
    Dim LastRowBQKMau As Long
  
    wsKCSKo.Select
    Cells(csHangTieuDe, csCotMaVatTu).End(xlDown).Select
    intSoLuongHang = ActiveCell.Row - csHangTieuDe
    
    Set shBQMau = ActiveWorkbook.Worksheets("BQ_Mau")
    Set shBQKMau = ActiveWorkbook.Worksheets("BQ_KMau")
    LastRowBQMau = shBQMau.Cells(Rows.count, "B").End(xlUp).Row
    LastRowBQKMau = shBQKMau.Cells(Rows.count, "B").End(xlUp).Row
    

    For H = 0 To intSoLuongHang - 1

            Set rgDuLieu = Cells(csHangTieuDe + 1 + H, csCotTonCuoiKCS)

            If (rgDuLieu.Value <> 0) Then
            
                intCount = intCount + 1
            
                rgTieuDe_NgayChot.Offset(intCount, 0).Value = NgayChot

                MaVatTu = Cells(rgDuLieu.Row(), csCotMaVatTu)
                MaKho = csMaKhoPXKCS
                For i = 7 To LastRowBQKMau
                For j = 7 To LastRowBQMau
                If shBQMau.Range("B" & j).Value = shBQKMau.Range("B" & i).Value Then
                MaVatTu = shBQKMau.Range("B" & j).Value
                Else
                MaVatTu = shBQKMau.Range("B" & i).Value
                End If
                Next j
                Next i

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

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

                SoLuong = rgDuLieu.Value
                If SoLuong < 0 Then
                    MsgBox ("Bang KCS, kiem tra lai ma " & MaVatTu & "-" & MaBeMat & " tai kho " & MaKho & " bi am " & SoLuong)
                End If
                rgTieuDe_SoLuong.Offset(intCount, 0).Value = SoLuong

            End If
          
NextH8:
    Next H

huongmuine · 9/11/17

NHờ các anh chị sửa giúp đoạn code trong file.
Khi nhập 1 vào ô K1 sheet AB thì code chạy nhưng nhập 2 code báo lỗi.
Xin cảm ơn

Ba Tê · 9/11/17

huongmuine đã viết:
NHờ các anh chị sửa giúp đoạn code trong file.
Khi nhập 1 vào ô K1 sheet AB thì code chạy nhưng nhập 2 code báo lỗi.
Xin cảm ơn

Lỗi tùm lum, không biết muốn sao.

huongmuine · 9/11/17

Ba Tê đã viết:
Lỗi tùm lum, không biết muốn sao.

Cảm ơn Thầy đã giúp đỡ.
NHờ Thầy giúp cho tí nữa ạ:
- Khi nhập 1 ở ô K1 sẽ lọc ra 10 dòng dữ liệu ( theo điều kiện tại vùng L1:Q3) từ sheet Data gán vào sheet AB như hiện tại
- Khi nhập 2 ở ô K1 sẽ lọc ra 10 dòng dữ liệu tiếp theo ( theo điều kiện tại vùng L1:Q3) từ sheet Data gán vào sheet AB và cột STT sẽ tính bắt đầu từ 11 đến 20
( trong file khi sửa dữ liệu cột lớp sheet Data thì sheet AB lọc không đủ 10 dòng dữ liệu )

concuarangme · 9/11/17

Nhờ các anh chị xem giúp edit code để tìm được trong các sub-folder nhé. File này của anh QuangHai mình tìm được nhưng mình không search được trong các sub-folder. Cảm ơn anh chị

huuthang_bd · 9/11/17

concuarangme đã viết:
Nhờ các anh chị xem giúp edit code để tìm được trong các sub-folder nhé. File này của anh QuangHai mình tìm được nhưng mình không search được trong các sub-folder. Cảm ơn anh chị

Có sẵn rồi mà sửa gì nữa.
Sửa

PHP:

   Sarr = GetAllFile(path, 0)

thành

PHP:

   Sarr = GetAllFile(path, True)

concuarangme · 9/11/17

huuthang_bd đã viết:
Có sẵn rồi mà sửa gì nữa.
Sửa

PHP:

Sarr = GetAllFile(path, 0)

thành

PHP:

Sarr = GetAllFile(path, True)

Mình đã edit thử rồi nhưng không search được, nếu để Sarr = GetAllFile(path, 0) thì search bình thường nhưng chỉ search folder hiện hành.

huuthang_bd · 9/11/17

concuarangme đã viết:
Mình đã edit thử rồi nhưng không search được, nếu để Sarr = GetAllFile(path, 0) thì search bình thường nhưng chỉ search folder hiện hành.

Bạn đưa file đã ê đít rồi mà không được tôi xem thử.

concuarangme · 9/11/17

huuthang_bd đã viết:
Bạn đưa file đã ê đít rồi mà không được tôi xem thử.

Nhờ bạn xem giúp nhé.

huuthang_bd · 9/11/17

concuarangme đã viết:
Nhờ bạn xem giúp nhé.

Tôi thử thì nó lấy cả trong thư mục con mà. Bạn kiểm tra lại xem file cần tìm có trong thư mục con không đã.

concuarangme · 9/11/17

huuthang_bd đã viết:
Tôi thử thì nó lấy cả trong thư mục con mà. Bạn kiểm tra lại xem file cần tìm có trong thư mục con không đã.

mình thử nhiều lần lắm rồi mà vẫn không được

Mình có chụp lại hình test thử
.

Ba Tê · 10/11/17

huongmuine đã viết:
Cảm ơn Thầy đã giúp đỡ.
NHờ Thầy giúp cho tí nữa ạ:
- Khi nhập 1 ở ô K1 sẽ lọc ra 10 dòng dữ liệu ( theo điều kiện tại vùng L1:Q3) từ sheet Data gán vào sheet AB như hiện tại
- Khi nhập 2 ở ô K1 sẽ lọc ra 10 dòng dữ liệu tiếp theo ( theo điều kiện tại vùng L1:Q3) từ sheet Data gán vào sheet AB và cột STT sẽ tính bắt đầu từ 11 đến 20
( trong file khi sửa dữ liệu cột lớp sheet Data thì sheet AB lọc không đủ 10 dòng dữ liệu )

Bạn xem lại file này, dữ liệu mẫu cũng phải tương đối có đủ dữ liệu, đưa dữ liệu chỉ có 1 lớp sao kiểm tra được?

huongmuine · 10/11/17

Ba Tê đã viết:
Bạn xem lại file này, dữ liệu mẫu cũng phải tương đối có đủ dữ liệu, đưa dữ liệu chỉ có 1 lớp sao kiểm tra được?

Vâng. Em cảm ơn Thầy.

thanhnt1910 · 11/11/17

Có cách nào chỉ nhập dữ liệu không trùng mà không nhập dữ liệu trùng không mọi người, ko dùng xóa dữ liệu trùng?

tiendungnst · 11/11/17

Ba Tê đã viết:
Thử xem file này coi có đúng ý bạn không.

Dạ đúng rồi ạ, e cảm ơn bác nhiều, nhưng e xin phép được nhờ thêm tí nữa ạ!
Hiện giờ dữ liệu ở M6 chỉ có thể được nhập khi có đủ điều kiện ở K6 là "CHUYỂN ĐƠN"
E muốn nó copy và lặp lại ở tất cả các dòng khi Em sử dụng nút thêm dòng để chèn thêm dòng trong bản tính, để tất cả các dòng chèn thêm đều đáp ứng được yêu cầu cầu tương ứng cho cột M khi có dữ liệu "CHUYỂN ĐƠN" ở cột K được ko ạ?
Nhờ Bác #Ba Tê xem giúp em!

Ba Tê · 12/11/17

tiendungnst đã viết:
Dạ đúng rồi ạ, e cảm ơn bác nhiều, nhưng e xin phép được nhờ thêm tí nữa ạ!
Hiện giờ dữ liệu ở M6 chỉ có thể được nhập khi có đủ điều kiện ở K6 là "CHUYỂN ĐƠN"
E muốn nó copy và lặp lại ở tất cả các dòng khi Em sử dụng nút thêm dòng để chèn thêm dòng trong bản tính, để tất cả các dòng chèn thêm đều đáp ứng được yêu cầu cầu tương ứng cho cột M khi có dữ liệu "CHUYỂN ĐƠN" ở cột K được ko ạ?
Nhờ Bác #Ba Tê xem giúp em!

Chuyển từ một ô sang một vùng?
Chèn dòng là chuyện của bạn, tôi không biết à nghe!

tiendungnst · 12/11/17

Ba Tê đã viết:
Chuyển từ một ô sang một vùng?
Chèn dòng là chuyện của bạn, tôi không biết à nghe!

Hoàn hảo rồi Bác ạ
Cảm ơn Bác nhiều nhiều!

Chuyên mục xử lý, gỡ rối code VBA

Huyền thoại GPE

Cạo Rồi Khỏi Gội

Thành viên GPE

Thành viên chính thức

File đính kèm

Thành viên mới

Thành viên GPE

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên GPE

File đính kèm

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Thành viên chính thức

Chuyên gia GPE

Thành viên chính thức

File đính kèm

Chuyên gia GPE

Thành viên chính thức

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên GPE

Thành viên mới

Thành viên chính thức

File đính kèm

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên chính thức

Facebook

Group