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

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

duytmd · 17/11/17

PacificPR đã viết:
Hình như cái File này em đã gặp ở đâu trên diễn đàn mình roài thì phải. (Hình như bài của anh "Sơn thủ bạc")

mình tìm được trên diễn đàn này, và có chỉnh sữa cho phù hợp hơn tí thôi. có mấy code khóa quá nên nhờ diễn đàn giúp

PacificPR · 17/11/17

duytmd đã viết:
mình tìm được trên diễn đàn này, và có chỉnh sữa cho phù hợp hơn tí thôi. có mấy code khóa quá nên nhờ diễn đàn giúp

Bạn qua đây có bài giống của bạn nè
http://www.giaiphapexcel.com/dienda...iền-và-link-đơn-giá.129787/page-4#post-815952

duytmd · 17/11/17

PacificPR đã viết:
Bạn qua đây có bài giống của bạn nè
http://www.giaiphapexcel.com/diendan/threads/nhờ-giúp-em-viết-code-vba-tính-cột-thành-tiền-và-link-đơn-giá.129787/page-4#post-815952

Mình có qua đó xem rồi và cũng timif được 1 1file gần tương tự nhưng mình chỉnh lại cứ báo lỗi.

PacificPR · 17/11/17

duytmd đã viết:
Mình có qua đó xem rồi và cũng timif được 1 1file gần tương tự nhưng mình chỉnh lại cứ báo lỗi.

Bác mở Topic mới rồi mình cùng làm nha. Đây là Chuyên mục xử lý, gỡ rối code VBA không làm dài dài được đâu

duytmd · 17/11/17

Nhờ các bạn chỉnh sửa code giúp mình:
1. Mình muốn chuyển cột j trong sheet "xuatDL" thành hàm PRODUCT(G11:I11)
2. Các hàng a) vật liệu, b)NC, C)Máy tại cột J tô đậm được ko?. Thank!

thinhraganok · 21/11/17

Chào mọi người,

Mình có 1 file excel như ở dưới. Hiện tại mình đang không biết dùng hàm gì để có thể tính được Doanh Số theo ngày ở Sheet Doanh Số. Về cơ bản thì Doanh Số của một ngày được tính bằng Doanh Số của tất cả các mặt hàng (Khoảng 800 mặt hàng tương đương với khoảng 800 sheets) bán được trong ngày đấy, và Doanh Số của một mặt hàng thì bằng số lượng mỗi nhân viên bán được trong ngày hôm đấy( Hùng, Hiếu, Thắng và Lẻ) nhân với giá của mặt hàng ở một sheet khác. Mình đã thử làm cách thủ công mà không được nên mình đang đọc và tìm hiểu về VBA, mong mọi người giúp mình xem nên dùng giải quyết được vấn đề tìm dữ liệu trong nhiều sheets và vòng lặp như thế nào.

Mình cảm ơn rất nhiều.
Do file nặng quá nên mình up lên googledriver: https://drive.google.com/open?id=1gPoxaJuKrkPth0XEIW1T-7cDFykfrQ5Y

Loannie · 22/11/17

Chào các bạn,
Mình tạo marco này để chuyển dữ liệu từ Sheet3 sang dạng Pivot Table và Tabular Form. Các bước như sau:
- Ctrl + Shift từ cột A tới cột H (số liệu sẽ cập nhật tiếp tục theo dòng) trong Sheet3
- Chọn tab Insert, chọn Pivot Table và tạo Pivot Table sang 1 sheet khác
- Sau khi tạo Pivot Table, ấn vào đó, để hiện lên PivotTable Tools => chọn tab Design => chọn không hiện Subtotals và Grand Totals trên báo cáo, và ấn vào Report Layout, chọn Show in Tabular Form.
- Lưu macro và chạy thử, báo lỗi.

Mình xin gửi file dữ liệu đây. Xin nhờ các chuyên gia chỉ dẫn sửa code VBA để chạy macro này.

Mình xin cảm ơn nhiều!

chisinhvnn · 22/11/17

Mã:

Private Sub cmdThem_Click()
    Dim Lr As Long, stt As Long
 
    Lr = Sheet7.Cells(Rows.Count, "B").End(3).Row
 
    If Me.cmbMaTS = "" Then
        MsgBox ("Ban chua chon kieu ma tai san")
        Me.cmbMaTS.SetFocus
        Exit Sub
    End If
    If Me.txtMaTS = "" Then
        MsgBox ("Ban chua nhap ma tai san")
        Me.txtMaTS.SetFocus
        Exit Sub
    End If
    With Sheet7
 
 
    stt = Application.WorksheetFunction.CountIf(.Range("$B$2:B" & Lr), Me.cmbMaTS.Value & " * ")
 
    Select Case stt
            Case Is < 10
                .Range("B" & Lr + 1) = StrConv(cmbMaTS.Value & Me.txtMaTS.Value & "00" & stt + 1, vbUpperCase)
            Case Is < 100
                .Range("B" & Lr + 1) = StrConv(cmbMaTS.Value & Me.txtMaTS.Value & "0" & stt + 1, vbUpperCase)
            Case Else
                .Range("B" & Lr + 1) = StrConv(cmbMaTS.Value & Me.txtMaTS.Value & stt + 1, vbUpperCase)
    End Select
    End With
End Sub

Xin chỉ giúp mình đở đoạn code

Mã:

stt = Application.WorksheetFunction.CountIf(.Range("$B$2:B" & Lr), Me.cmbMaTS.Value & " * ")

Stt nó không đánh được số thứ tự theo mã ở cmbMaTS nhỉ.b
Mục đích của mình tạo ra mã hàng theo cmbMaTS & txtMaTS và STT theo cmbMaTS

LYSM · 22/11/17

Xem giúp em code này ạ

Sub clean()
On Error Resume Next
Dim arr, arr1, res, res1, i As Long, j As Long, k As Long, k1 As Long
With Sheets("Du lieu vao")
arr = .Range(.[A10], .[A65000].End(xlUp)).Resize(, 22).Value
arr1 = .Range(.[X10], .[X65000].End(xlUp)).Resize(, 2).Value
ReDim res(1 To UBound(arr, 1), 1 To 22)
ReDim res1(1 To UBound(arr, 1), 1 To 2)
For i = 1 To UBound(arr, 1)
If DateAdd("m", 13, arr(i, 1)) >= Date Then
k = k + 1
For j = 1 To 22
res(k, j) = arr(i, j)
Next j
End If
Next i
For i = 1 To UBound(arr1, 1)
If DateAdd("m", 13, arr1(i, 1)) >= Date Then
k1 = k1 + 1
res1(k1, 1) = arr1(i, 1)
res1(k1, 2) = arr1(i, 2)
End If
Next i
.Range("A10:Y10000").ClearContents
If k Then .Range("A10").Resize(k, 22).Value = res
If k1 Then .Range("X10").Resize(k1, 2).Value = res1
End With
End Sub

Nếu dữ liệu cột X,Y có số dòng dài hơn dữ liệu cột A:V thì phần dài hơn sẽ bị lỗi N/A. Em cảm ơn

dhn46 · 22/11/17

LYSM đã viết:
Xem giúp em code này ạ

Sub clean()
On Error Resume Next
Dim arr, arr1, res, res1, i As Long, j As Long, k As Long, k1 As Long
With Sheets("Du lieu vao")
arr = .Range(.[A10], .[A65000].End(xlUp)).Resize(, 22).Value
arr1 = .Range(.[X10], .[X65000].End(xlUp)).Resize(, 2).Value
ReDim res(1 To UBound(arr, 1), 1 To 22)
ReDim res1(1 To UBound(arr, 1), 1 To 2)
For i = 1 To UBound(arr, 1)
If DateAdd("m", 13, arr(i, 1)) >= Date Then
k = k + 1
For j = 1 To 22
res(k, j) = arr(i, j)
Next j
End If
Next i
For i = 1 To UBound(arr1, 1)
If DateAdd("m", 13, arr1(i, 1)) >= Date Then
k1 = k1 + 1
res1(k1, 1) = arr1(i, 1)
res1(k1, 2) = arr1(i, 2)
End If
Next i
.Range("A10:Y10000").ClearContents
If k Then .Range("A10").Resize(k, 22).Value = res
If k1 Then .Range("X10").Resize(k1, 2).Value = res1
End With
End Sub

Nếu dữ liệu cột X,Y có số dòng dài hơn dữ liệu cột A:V thì phần dài hơn sẽ bị lỗi N/A. Em cảm ơn

Bạn thêm vào 2 dòng lệnh sau, nếu đặt biến ngay từ đầu thì tốt hơn (t = Ubound(...))

Mã:

   For i = 1 To UBound(arr1, 1)
     If i < UBound(arr, 1) + 1 Then '<=== Them vao
     If DateAdd("m", 13, arr1(i, 1)) >= Date Then
        k1 = k1 + 1
        res1(k1, 1) = arr1(i, 1)
        res1(k1, 2) = arr1(i, 2)
     End If
     End If                            '<=== Them vao
   Next i

LYSM · 22/11/17

dhn46 đã viết:
Bạn thêm vào 2 dòng lệnh sau, nếu đặt biến ngay từ đầu thì tốt hơn (t = Ubound(...))

Mã:

For i = 1 To UBound(arr1, 1) If i < UBound(arr, 1) + 1 Then '<=== Them vao If DateAdd("m", 13, arr1(i, 1)) >= Date Then k1 = k1 + 1 res1(k1, 1) = arr1(i, 1) res1(k1, 2) = arr1(i, 2) End If End If '<=== Them vao Next i

Bác ơi, vậy trong trường hợp i>ubound(arr,1) thì làm thế nào?

dhn46 · 22/11/17

LYSM đã viết:
Bác ơi, vậy trong trường hợp i>ubound(arr,1) thì làm thế nào?

Như file của bạn thì tôi tạm hiểu rằng bạn sử dụng 2 Array, 1 cho cột A (arr) và 1 cho cột X (arr1)

Nếu số phần tử tại cột A < cột X thì cột X sẽ không hiện ra (Code cũ sẽ là giá trị #NA), nếu lớn hơn thì bạn phải nêu muốn cái gì chứ.

chisinhvnn · 22/11/17

Mã:

Private Sub txtTim_Change()
If Me.txtTim = "" Then
    Me.lsbTim.Visible = False
    ElseIf Me.txtTim.Value = "?" Then
        nhaplieu.Hide        (nhaplieu form hiện hành muốn ẩn)
        nhaptaisan.Show    (nhập tài sản form muốn hiện)
    Else
    Me.lsbTim.Visible = True

Mọi người xem giúp code trên sai ở đâu mà bị lỗi ở đoạn code
nhaplieu.Hide (nhaplieu form hiện hành)
nhaptaisan.Show (nhập tài sản form muốn hiện)

Do Nam Trung · 22/11/17

Mình có Record Macro đoạn Code Copy:

Mã:

Sub CopyDulieu()
F.Range("D4:D8,D10:D52,D54:D77,D82:D87").ClearContents
F.Range("I4:I8").Copy
F.Range("D4:D8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
F.Range("I10:I52").Copy
F.Range("D10:D52").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
F.Range("I54:I77").Copy
F.Range("D54:D77").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
F.Range("I82:I87").Copy
F.Range("D82:D87").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
F.Range("D3").Activate
Application.CutCopyMode = False
End Sub

Khi chạy lệnh thì ok như ý ,Nhưng nó nhẩy nhoáng nhoáng nhìn ko được đẹp mắt và code cũng dài quá...nên nhờ các bạn sửa lại cho nó gọn hơn ,chạy mượt hơn...xin cảm ơn trước.

LYSM · 23/11/17

dhn46 đã viết:
Như file của bạn thì tôi tạm hiểu rằng bạn sử dụng 2 Array, 1 cho cột A (arr) và 1 cho cột X (arr1)

Nếu số phần tử tại cột A < cột X thì cột X sẽ không hiện ra (Code cũ sẽ là giá trị #NA), nếu lớn hơn thì bạn phải nêu muốn cái gì chứ.

Thì đó là cái em đang bị lỗi, cái em muốn là 2 array đó độc lập với nhau, ngày tháng trên mỗi array >13 tháng thì sẽ bị loại bỏ, vì số liệu bên em nhập liên tục nên nếu không bỏ dữ liệu cũ thì sẽ dài mãi file ngày càng nặng nề.

dhn46 · 23/11/17

LYSM đã viết:
Thì đó là cái em đang bị lỗi, cái em muốn là 2 array đó độc lập với nhau, ngày tháng trên mỗi array >13 tháng thì sẽ bị loại bỏ, vì số liệu bên em nhập liên tục nên nếu không bỏ dữ liệu cũ thì sẽ dài mãi file ngày càng nặng nề.

Bạn xem lại khai báo Res1 và sửa thành

Mã:

   ReDim res1(1 To UBound(arr1, 1), 1 To 2)

LYSM · 23/11/17

dhn46 đã viết:
Bạn xem lại khai báo Res1 và sửa thành

Mã:

ReDim res1(1 To UBound(arr1, 1), 1 To 2)

Oh, mắt mũi kém quá, em check mãi Ko ra lỗi. Tks bác nhé

chisinhvnn · 23/11/17

Mình có tạo form tìm kiếm. Khi gõ vào textbox dấu "?" thì form hiện tại ẩn đi, và mở 1 form mới.
Mình viết code như thế này mà bị lỗi nhưng không biết cách khắc phục.

Mã:

Private Sub txtTim_Change()
If Me.txtTim = "" Then
    Me.lsbTim.Visible = False
    ElseIf Me.txtTim.Value = "?" Then
        nhaplieu.Hide
        nhaptaisan.Show
    Else
    Me.lsbTim.Visible = True
Dim arr, sArray

    sArray = Sheet4.Range("A2:E" & Sheet4.[B65000].End(xlUp).Row)
 
    On Error Resume Next

    If Len(Trim(txtTim.Value)) = 0 Then Me.lsbTim.List() = sArray: Exit Sub

    arr = Filter2DArray(sArray, 2, "*" & txtTim.Value & "*", False) 'goc la so 1 "cot tim kiem)

    If Not IsArray(arr) Then
        arr = Filter2DArray(sArray, 3, "*" & txtTim.Value & "*", False)

        If Not IsArray(arr) Then lsbTim.Clear: Exit Sub

    End If

    Me.lsbTim.List() = IIf(Trim(txtTim.Text) = "", sArray, arr)
   
End If


End Sub

Nhờ GPE giúp đỡ. (lỗi lúc đoạn ẩn, hiện form)

dhn46 · 25/11/17

LYSM đã viết:
Oh, mắt mũi kém quá, em check mãi Ko ra lỗi. Tks bác nhé

Bạn bỏ phần On error resume next là thấy ngay ấy mà. Bug lỗi code mà cho phần đó vào thì không kiểm soát được đâu bạn ah.

Binbo2020 · 25/11/17

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

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

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

Huyền thoại GPE

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

Thành viên mới

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

File đính kèm

Thành viên mới

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

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Thành viên tiêu biểu

File đính kèm

Thành viên thường trực

File đính kèm

Hướng tới tương lai

Thành viên thường trực

Hướng tới tương lai

Thành viên tiêu biểu

Thành viên mới

Thành viên thường trực

Hướng tới tương lai

Thành viên thường trực

Thành viên tiêu biểu

Hướng tới tương lai

Thành viên tích cực

File đính kèm

Đếm ngược thời gian