Chuyên mục xử lý, gỡ rối code VBA (3 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

mtuan · 11/6/18

giaiphap đã viết:
Tiền tệ cột nào bạn và bị lỗi ra sao?

DẠ EM LÀM ĐƯỢC RỒI A. CẢM ƠN A NHIỀU

mtuan · 12/6/18

giaiphap đã viết:
Tiền tệ cột nào bạn và bị lỗi ra sao?

Nhờ A kiểm tra lại dùm đoạn code xem sao cột L14:L gí trị Sum() thì đúng còn giá trị tổng tiền có 1 giá.
vd: số lượng*TSC*(đơn giá+trợ giá) cho ra cùng 1 kết quả cho dù số lượng có bao nhiêu cũng vậy.
A thông cảm cho em làm phiền tí nha.
CẢm ơn A
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
Ngay = Target.Value: KHO = Sheet25.[$C$7]
iCol = Array(9, 4, 5, 6, 7, 1, 11, 1, 1, 10, 12, 1, 13)
For i = LBound(Arr, 1) To UBound(Arr, 1)
If (Ngay >= Arr(i, 2)) And (KHO = Arr(i, 8)) Then
k = k + 1
For j = 0 To 12
If iCol(j) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
Next j
End If
Next i
Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
If k <> 0 Then
With Sheet25
.Range("A14").Resize(k, 13).Value = dArr
.Sort.SortFields.Clear
.Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
.Range("L14").FormulaR1C1 = "=RC[-5]*RC[-2]*(RC[-1]+RC[1])"
.Range("L14").AutoFill Destination:=.Range("L14:L" & (k + 13)), Type:=xlFillDefault
.Range("L14:L" & (k + 13)).Value = .Range("L14:L" & (k + 13)).Value
j = .Range("A65000").End(xlUp).Row
For i = j To 13 Step -1
If .Range("M" & i) <> .Range("M" & (i - 1)) Then
.Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
.Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
.Range("B" & i).Font.Name = "VNI-Times"
.Range("B" & i & ":L" & i).Font.Bold = True
End If
Next i
For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
.Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
.Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
Next
.Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
With .Range("A65000").End(xlUp)
.Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
.Offset(1).Resize(, 13).Font.Name = "VNI-Times"
.Offset(1).Resize(, 13).Font.Bold = True
.Offset(1).Resize(, 13).Font.Color = -16776961
.Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
.Offset(1).Resize(, 6).Merge
.Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
.Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
End With
.Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
With .Range("A65000").End(xlUp).Offset(1)
.Value = "Baèng chöõ:"
.Offset(, 1).Formula = "=HamDocTV(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
.Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
.Offset(2, 1).Font.Bold = True
.Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
.Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
.Offset(2, 11).Font.Bold = True
.Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
.Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
.Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
.Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
.Resize(5, 13).Font.Name = "VNI-Times"
End With
End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End If
End Sub

haianh89 · 12/6/18

Nhờ các bác hỗ trợ,

Do mình mới đọc code nên chưa rõ lắm, nhờ được các ACE hỗ trợ đặc biệt là bác HLMT (cảm ơn bác nhiều lắm)
Nhưng có một số lỗi mình không tự dò được:
- Phần định dạng cột dữ liệu trong đoạn [DOANH SO T4] mình cần định dạng số liệu dạng #,###
- Khi bảng dữ liệu ra dư 1 dòng cuối cùng.
đoạn code như sau:
và file đính kèm.

Sub GuiMail_11062018()

Dim objOutlook, objOutlookMsg, cn, rst As Object

Dim arr As Variant

Dim str1, str2, str3 As String

Dim i As Integer

Set objOutlook = CreateObject("Outlook.Application")

Set objOutlookMsg = objOutlook.CreateItem(0)

Set cn = CreateObject("ADODB.Connection")

Set rst = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"

rst.Open ("select * from [DS_MAIL$]"), cn

arr = rst.GetRows()

rst.Close

For i = 3 To UBound(arr)

rst.Open ("select [SL POS T4],[DOANH SO T4],[PHI THU T4],[SL POS T5],[DOANH SO T5],[PHI THU T5],[+/- SL T5 VA T4],[% KH SL],[+/- DS T5 VA T4],[% KH DS],[+/- PT T5 VA T4],[% KH Phí] from [Data 1$] where MADV='" & arr(1, i) & "'"), cn, 3

If rst.RecordCount > 0 Then

str1 = rst.GetString(, , "</td><td>", "</tr><tr>")

Else

str1 = ""

End If

rst.Close

rst.Open ("select [Ghi Chú] from [Data 1$] where MaDv='" & arr(1, i) & "'"), cn

If rst.RecordCount > 0 Then

str3 = rst.GetString(, , "</td><td>", "</tr><tr>")

Else

str3 = ""

End If

rst.Close

rst.Open ("select [STT],[Tid Local-Visa],[Tid Master],[Tên DVCNT],[Adress],[Phone],[Active date],[POS Type],[Status],[Serial POS],[Code NV],[Ghi chú] from [Data 2$] where MaDv='" & arr(1, i) & "'"), cn

If rst.RecordCount > 0 Then

str2 = rst.GetString(, , "</td><td>", "</tr><tr>")

Else

str2 = ""

End If

If Len(str1) > 0 And Len(str2) > 0 Then

Set objOutlookMsg = objOutlook.CreateItem(0)

With objOutlookMsg

.To = arr(2, i)

.CC = arr(3, i)

.Subject = Sheet4.[A1] & arr(1, i)

.HTMLBody = "" & Sheet4.[A3] & " " & Sheet4.[A5] & _

" <table border='1'><th>SL POS T4</th><th>DOANH SO T4</th><th>PHI THU T4</th><th>SL POS T5</th><th>DOANH SO T5</th><th>PHI THU T5</th><th>+/- SL T5 VA T4</th><th>% KH SL</th><th>+/- DS T5 VA T4</th><th>% KH DS</th><th>+/- PT T5 VA T4</th><th>% KH Phí</th> <tr>" & _

str1 & "</table> " & Sheet4.[A7] & _

" &nbsp&nbsp&nbsp&nbspØ " & str3 & _

" &nbsp&nbsp&nbsp&nbspØ " & _

Sheet4.[A9] & " " & _

Sheet4.[A10] & _

"<table border='1'><th>STT</th><th>Tid Local-Visa</th><th>Tid Master</th><th>Tên DVCNT</th><th>Adress</th><th>Phone</th><th>Active date</th><th>POS Type</th><th>Status</th><th>Serial POS</th><th>Code NV</th><th>Ghi chú</th> <tr>" & str2 & "</table> " & _

Sheet4.[A12] & " " & _

Sheet4.[A14] & ""

.Display

End With

End If

rst.Close

Next

End Sub

giaiphap · 12/6/18

mtuan đã viết:
Nhờ A kiểm tra lại dùm đoạn code xem sao cột L14:L gí trị Sum() thì đúng còn giá trị tổng tiền có 1 giá.
vd: số lượng*TSC*(đơn giá+trợ giá) cho ra cùng 1 kết quả cho dù số lượng có bao nhiêu cũng vậy.
A thông cảm cho em làm phiền tí nha.
CẢm ơn A
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
Ngay = Target.Value: KHO = Sheet25.[$C$7]
iCol = Array(9, 4, 5, 6, 7, 1, 11, 1, 1, 10, 12, 1, 13)
For i = LBound(Arr, 1) To UBound(Arr, 1)
If (Ngay >= Arr(i, 2)) And (KHO = Arr(i, 8)) Then
k = k + 1
For j = 0 To 12
If iCol(j) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
Next j
End If
Next i
Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
If k <> 0 Then
With Sheet25
.Range("A14").Resize(k, 13).Value = dArr
.Sort.SortFields.Clear
.Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
.Range("L14").FormulaR1C1 = "=RC[-5]*RC[-2]*(RC[-1]+RC[1])"
.Range("L14").AutoFill Destination:=.Range("L14:L" & (k + 13)), Type:=xlFillDefault
.Range("L14:L" & (k + 13)).Value = .Range("L14:L" & (k + 13)).Value
j = .Range("A65000").End(xlUp).Row
For i = j To 13 Step -1
If .Range("M" & i) <> .Range("M" & (i - 1)) Then
.Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
.Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
.Range("B" & i).Font.Name = "VNI-Times"
.Range("B" & i & ":L" & i).Font.Bold = True
End If
Next i
For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
.Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
.Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
Next
.Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
With .Range("A65000").End(xlUp)
.Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
.Offset(1).Resize(, 13).Font.Name = "VNI-Times"
.Offset(1).Resize(, 13).Font.Bold = True
.Offset(1).Resize(, 13).Font.Color = -16776961
.Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
.Offset(1).Resize(, 6).Merge
.Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
.Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
End With
.Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
With .Range("A65000").End(xlUp).Offset(1)
.Value = "Baèng chöõ:"
.Offset(, 1).Formula = "=HamDocTV(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
.Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
.Offset(2, 1).Font.Bold = True
.Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
.Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
.Offset(2, 11).Font.Bold = True
.Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
.Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
.Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
.Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
.Resize(5, 13).Font.Name = "VNI-Times"
End With
End With
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End If
End Sub

Bạn nêu vd mẫu cụ thể đi, cột nào bằng bao nhiêu, do đâu, sai chổ nào, như thế nào mới đúng, nhưng nhớ phải là con số cụ thể.

mtuan · 12/6/18

giaiphap đã viết:
Bạn nêu vd mẫu cụ thể đi, cột nào bằng bao nhiêu, do đâu, sai chổ nào, như thế nào mới đúng, nhưng nhớ phải là con số cụ thể.

Nhờ A xem cột tô đỏ. Cảm ơn nhiều

Sunbinsuzin · 12/6/18

truongvu317 đã viết:
Đưa file, kèm theo mô tả mục đích, mọi người viết lại cho nhanh, chứ chỉnh mấy cái macro mất nhiều thời gian mà vẫn dễ có lỗi.

giaiphap đã viết:

Nếu chỉ dùng code để copy dữ liệu không thì dùng code này.

Mã:

Private Sub Workbook_Open()
Dim Wb As Workbook, tWb As Workbook
Set tWb = ThisWorkbook
    tWb.Sheets("PO").Cells.ClearContents
    tWb.Sheets("GIA").Cells.ClearContents
    Set Wb = Workbooks.Open(tWb.Path & "\PO.xlsx")
    Wb.Sheets(1).Cells.Copy tWb.Sheets("PO").Range("A1")
    Wb.Close False
    Set Wb = Workbooks.Open(tWb.Path & "\Gia.xlsx")
    Wb.Sheets(1).Cells.Copy tWb.Sheets("Gia").Range("A1")
    Wb.Close False
End Sub

Mục đích của em là lấy Giá ở trong file PO history dựa và TÊN VẬT TƯ và PO.
Dữ liệu đầu vào của em chỉ có TÊN VẬT TƯ còn PO thì tìm trong FilelayPO dựa và TÊN VẬT TƯ và MAX số lượng của loại TÊN VẬT TƯ đó.
Bác giaiphap đã giúp em code copy dữ liệu và 1 file để tiện sử lý dữ liệu nhưng mà file PO history ở Cty em có password mở file, password chỉ đọc và 1 cái thông báo link ko tìm thấy file khi mở trên máy của em.
Bác có thể viết thêm dùm em đoạn:
Code kiểm tra file đó có tồn tại không trước khi mở file copy dữ liệu dùm em vợi ạ " vì sever Cty em hay rớt mạng"
Code tự động nhập password vào file PO history "VD Password: 123456", bỏ qua cái bảng thông báo nhập pass chỉ đọc và 1 cái bảng thông báo link hỏng được không ạ. Nếu sai password thì thông báo sai password.
Code tự động lấy các thông tim khi nhập thêm dữ liệu vào cột TÊN VẬT TƯ.
Code chuyển đổi 2 cái hàm tìm PO và Số lượng sang code
Và cuối cùng đoạn code ở dưới em tham khảo bài #1784 nhưng không hiểu sao code chỉ hiện được có 6 kết quả trong khi chạy bằng hàm thì ra rất nhiều kết quả. Và không hiểu sao lúc em đang text code hiện ra hết quả mà giờ lại hết hiện kết quả luôn.
Sub test()
Dim I, lr As Integer
lr = Sheets("THONGTIN").Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To lr
If Sheets("GIA").Range("A" & I) = Sheets("THONGTIN").Range("O" & I) And _
Sheets("GIA").Range("B" & I) = Sheets("THONGTIN").Range("M" & I) Then
Sheets("GIA").Range("D" & I).Value = Sheets("Thongtin").Range("V" & I).Value
End If
Next
End Sub

Thank Bác

giaiphap · 12/6/18

mtuan đã viết:
Nhờ A xem cột tô đỏ. Cảm ơn nhiều

Sửa lại code thế này xem sao?

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 1, 11, 1, 1, 10, 12, 25, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay >= Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) <> 1 Then
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 13 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=HamDocTV(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub

Sunbinsuzin đã viết:
Mục đích của em là lấy Giá ở trong file PO history dựa và TÊN VẬT TƯ và PO.
Dữ liệu đầu vào của em chỉ có TÊN VẬT TƯ còn PO thì tìm trong FilelayPO dựa và TÊN VẬT TƯ và MAX số lượng của loại TÊN VẬT TƯ đó.
Bác giaiphap đã giúp em code copy dữ liệu và 1 file để tiện sử lý dữ liệu nhưng mà file PO history ở Cty em có password mở file, password chỉ đọc và 1 cái thông báo link ko tìm thấy file khi mở trên máy của em.
Bác có thể viết thêm dùm em đoạn:
Code kiểm tra file đó có tồn tại không trước khi mở file copy dữ liệu dùm em vợi ạ " vì sever Cty em hay rớt mạng"
Code tự động nhập password vào file PO history "VD Password: 123456", bỏ qua cái bảng thông báo nhập pass chỉ đọc và 1 cái bảng thông báo link hỏng được không ạ. Nếu sai password thì thông báo sai password.
Code tự động lấy các thông tim khi nhập thêm dữ liệu vào cột TÊN VẬT TƯ.
Code chuyển đổi 2 cái hàm tìm PO và Số lượng sang code
Và cuối cùng đoạn code ở dưới em tham khảo bài #1784 nhưng không hiểu sao code chỉ hiện được có 6 kết quả trong khi chạy bằng hàm thì ra rất nhiều kết quả. Và không hiểu sao lúc em đang text code hiện ra hết quả mà giờ lại hết hiện kết quả luôn.
Sub test()
Dim I, lr As Integer
lr = Sheets("THONGTIN").Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To lr
If Sheets("GIA").Range("A" & I) = Sheets("THONGTIN").Range("O" & I) And _
Sheets("GIA").Range("B" & I) = Sheets("THONGTIN").Range("M" & I) Then
Sheets("GIA").Range("D" & I).Value = Sheets("Thongtin").Range("V" & I).Value
End If
Next
End Sub

Thank Bác
View attachment 197276

Tôi thì mù tịch về công thức mảng, chính vì vậy nhìn công thức mảng của bạn thì chịu. Bạn giải thích rõ từng cột lấy ra sao, dựa vào tiêu chí nào, tại sao lại không lấy giá trị này mà phải lấy giá trị khác...

mtuan · 12/6/18

giaiphap đã viết:

Sửa lại code thế này xem sao?

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 1, 11, 1, 1, 10, 12, 25, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay >= Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) <> 1 Then
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 13 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=HamDocTV(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub

OK rồi Anh. Quá tuyệt
Chân thành cảm ơn A đã giúp đỡ

Bài đã được tự động gộp: 12/6/18

Code ok rồi Anh quá tuyệt
Chân thành cảm ơn Anh

Sunbinsuzin · 12/6/18

giaiphap đã viết:

Sửa lại code thế này xem sao?

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet9.Range("A2:O" & Sheet9.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 1, 11, 1, 1, 10, 12, 25, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay >= Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) <> 1 Then
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 13 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=HamDocTV(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub

Tôi thì mù tịch về công thức mảng, chính vì vậy nhìn công thức mảng của bạn thì chịu. Bạn giải thích rõ từng cột lấy ra sao, dựa vào tiêu chí nào, tại sao lại không lấy giá trị này mà phải lấy giá trị khác...

Dạ để em giải thích:
Khi nhận được đơn hàng sẽ kiểm tra tồn kho còn bao nhiêu, nếu thiếu thì mua thêm
khi tính giá thì tính theo số lượng vật tư nào sử dụng nhiều hơn (nếu vật tư cũ sử dụng nhiều hơn thì lấy giá cũ, nếu vật tư mới mua về sử dụng nhiều hơn thì sẽ lấy giá mới mua)
Ví dụ khi nắp ráp 1000 linh kiện vào ngày 12/06/2018 mình cần 3000 vật tư A, 4000 vật tư B thì Cty em tính như vầy:
sẽ lấy toàn bộ 1000 vật tư A của PO 18051033 số còn thiếu là 2000 vật tư A sẽ lấy của PO 18051034 nên sẽ lấy Giá mua/0.55 đô
lấy toàn bộ 3000 vật tư B của PO 18051040 số còn thiếu là 1000 vật tư A sẽ lấy của PO 18051034 nênsẽ lấy Giá mua/0.40 đô
Linh liện/ A Số hóa đơn(PO)/ 18051033 Số Lượng/1000 Ngày Mua/12/01/2017 Giá mua/0.50 đô
Linh liện/ A Số hóa đơn(PO)/ 18051034 Số Lượng/7000 Ngày Mua/12/05/2018 Giá mua/0.55 đô
Linh liện/ B Số hóa đơn(PO)/ 18051040 Số Lượng/3000 Ngày Mua/12/01/2017 Giá mua/0.40 đô
Linh liện/ B Số hóa đơn(PO)/ 18051034 Số Lượng/4000 Ngày Mua/12/05/2018 Giá mua/0.49 đô
Những thông tin trong 3 file trên là người ta sẽ giử cho mình còn mình chỉ việc ráp giá vào là xong ạ.
cám ơn bác đã qua tâm giúp đỡ

giaiphap · 12/6/18

Sunbinsuzin đã viết:
Dạ để em giải thích:
Khi nhận được đơn hàng sẽ kiểm tra tồn kho còn bao nhiêu, nếu thiếu thì mua thêm
khi tính giá thì tính theo số lượng vật tư nào sử dụng nhiều hơn (nếu vật tư cũ sử dụng nhiều hơn thì lấy giá cũ, nếu vật tư mới mua về sử dụng nhiều hơn thì sẽ lấy giá mới mua)
Ví dụ khi nắp ráp 1000 linh kiện vào ngày 12/06/2018 mình cần 3000 vật tư A, 4000 vật tư B thì Cty em tính như vầy:
sẽ lấy toàn bộ 1000 vật tư A của PO 18051033 số còn thiếu là 2000 vật tư A sẽ lấy của PO 18051034 nên sẽ lấy Giá mua/0.55 đô
lấy toàn bộ 3000 vật tư B của PO 18051040 số còn thiếu là 1000 vật tư A sẽ lấy của PO 18051034 nênsẽ lấy Giá mua/0.40 đô
Linh liện/ A Số hóa đơn(PO)/ 18051033 Số Lượng/1000 Ngày Mua/12/01/2017 Giá mua/0.50 đô
Linh liện/ A Số hóa đơn(PO)/ 18051034 Số Lượng/7000 Ngày Mua/12/05/2018 Giá mua/0.55 đô
Linh liện/ B Số hóa đơn(PO)/ 18051040 Số Lượng/3000 Ngày Mua/12/01/2017 Giá mua/0.40 đô
Linh liện/ B Số hóa đơn(PO)/ 18051034 Số Lượng/4000 Ngày Mua/12/05/2018 Giá mua/0.49 đô
Những thông tin trong 3 file trên là người ta sẽ giử cho mình còn mình chỉ việc ráp giá vào là xong ạ.
cám ơn bác đã qua tâm giúp đỡ

Tôi thuộc dạng luôn luôn lắng nghe, nhưng lâu lâu mới hiểu. Chính vì vậy bạn giải thích thật sự tôi chẳng hiểu luôn, thôi thì giúp được cho bạn cái này nhé, còn cái còn lại nếu hiểu thì làm còn hiện giờ chưa hiểu gì cả. Bạn thêm code này cho Module.

Mã:

Function File_Check(s As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
File_Check = fso.FileExists(s)
End Function

Bạn sửa code trong ThisWorkbook như sau:

Mã:

Private Sub Workbook_Open()
Dim wb As Workbook, tWb As Workbook
Set tWb = ThisWorkbook
    tWb.Sheets("PO").Cells.Clear
    tWb.Sheets("THONGTIN").Cells.Clear
    On Error GoTo Loi
    If Not File_Check(ThisWorkbook.Path & "\FilelayPO.xlsx") Then
        MsgBox "Ten tin FilelayPO.xlsx khong ton tai"
        Exit Sub
    End If
    If Not File_Check(ThisWorkbook.Path & "\PO history.xlsx") Then
        MsgBox "Ten tin PO history.xlsx khong ton tai"
        Exit Sub
    End If
    Set wb = Workbooks.Open(tWb.Path & "\FilelayPO.xlsx")
    wb.Sheets(1).Cells.Copy tWb.Sheets("PO").Range("A1")
    wb.Close False
    Set wb = Workbooks.Open(tWb.Path & "\PO history.xlsx", Password:="11", writeResPassword:="1", UpdateLinks:=0)
    wb.Sheets(1).Cells.Copy tWb.Sheets("THONGTIN").Range("A1")
    wb.Close False
Loi:
    If Err.Number = 1004 Then MsgBox "Passwork mo file chua chinh xac"
End Sub

Sunbinsuzin · 13/6/18

giaiphap đã viết:
Tôi thuộc dạng luôn luôn lắng nghe, nhưng lâu lâu mới hiểu. Chính vì vậy bạn giải thích thật sự tôi chẳng hiểu luôn, thôi thì giúp được cho bạn cái này nhé, còn cái còn lại nếu hiểu thì làm còn hiện giờ chưa hiểu gì cả. Bạn thêm code này cho Module.

Mã:

Function File_Check(s As String) As Boolean Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") File_Check = fso.FileExists(s) End Function

Bạn sửa code trong ThisWorkbook như sau:

Mã:

Private Sub Workbook_Open() Dim wb As Workbook, tWb As Workbook Set tWb = ThisWorkbook tWb.Sheets("PO").Cells.Clear tWb.Sheets("THONGTIN").Cells.Clear On Error GoTo Loi If Not File_Check(ThisWorkbook.Path & "\FilelayPO.xlsx") Then MsgBox "Ten tin FilelayPO.xlsx khong ton tai" Exit Sub End If If Not File_Check(ThisWorkbook.Path & "\PO history.xlsx") Then MsgBox "Ten tin PO history.xlsx khong ton tai" Exit Sub End If Set wb = Workbooks.Open(tWb.Path & "\FilelayPO.xlsx") wb.Sheets(1).Cells.Copy tWb.Sheets("PO").Range("A1") wb.Close False Set wb = Workbooks.Open(tWb.Path & "\PO history.xlsx", Password:="11", writeResPassword:="1", UpdateLinks:=0) wb.Sheets(1).Cells.Copy tWb.Sheets("THONGTIN").Range("A1") wb.Close False Loi: If Err.Number = 1004 Then MsgBox "Passwork mo file chua chinh xac" End Sub

Em nghĩ tại Bác có ác cảm gì đó với hàm mảng thông chứ Bác lập trình hay vậy thì làm gì có chuyện ko ..... thực ra em nghĩ khi mình sử dụng hàm mảng trong exccel thì excel sẽ dùng vòng nặp để tìm giá trị cho cell.
Em làm lại 1 cái file nhưng em tách hàm ra và dữ liệu thì dễ nhìn hơn. Bác rảnh thì vào xem dùm em với ạ.
thank bác

copyright · 13/6/18

Chào cả nhà ạ.

Cả nhà cho em hỏi. Em muốn chuyển biểu thức ở dạng chuỗi( vd "800>=500" ; "1000<300") về kiểu logic bằng cách nào ạ.

Em cám ơn.

giaiphap · 14/6/18

copyright đã viết:
Chào cả nhà ạ.

Cả nhà cho em hỏi. Em muốn chuyển biểu thức ở dạng chuỗi( vd "800>=500" ; "1000<300") về kiểu logic bằng cách nào ạ.

Em cám ơn.

Bạn tìm hiểu lệnh này.

Mã:

 Application.Evaluate

AutoReply · 14/6/18

giaiphap đã viết:
Bạn tìm hiểu lệnh này.

Mã:

Application.Evaluate

Dạ em tìm nhưng chưa có hiểu, anh giúp em áp dụng với. Cám ơn anh.

truongvu317 · 14/6/18

AutoReply đã viết:
Dạ em tìm nhưng chưa có hiểu, anh giúp em áp dụng với. Cám ơn anh.

Chưa hiểu chỗ nào, qua đây tui giúp cho. Cứ gõ ý nguyên vào là được mà.

AutoReply · 14/6/18

truongvu317 đã viết:
Chưa hiểu chỗ nào, qua đây tui giúp cho. Cứ gõ ý nguyên vào là được mà.

mình gõ y nguyên vào rồi mà đâu có được đâu :

Mã:

MsgBox Application.Evaluate("800>=500" ; "1000<300")

Ba Tê · 14/6/18

AutoReply đã viết:
mình gõ y nguyên vào rồi mà đâu có được đâu :

Mã:

MsgBox Application.Evaluate("800>=500" ; "1000<300")

Như vầy thôi:
MsgBox Application.Evaluate("800>=500")
2, 3 chuỗi như vậy sao anh Bill hiểu kết quả là gì.

truongvu317 · 14/6/18

AutoReply đã viết:
mình gõ y nguyên vào rồi mà đâu có được đâu :

Gái xinh có khác, suy nghĩ cũng hại nào phết nhỉ, người ta hỏi tách bạch là ("800>=500" ; "1000<300" ), hai biểu thức riêng biệt, chứ có phải là m ột đâu mà nhét chúng vào một mớ chứ.

Bài đã được tự động gộp: 14/6/18

Ba Tê đã viết:
2, 3 chuỗi như vậy sao anh Bill hiểu kết quả là gì.

Viết thế là sai cú pháp luôn, chứ 2 3 biểu thức gì trời.

AutoReply · 14/6/18

truongvu317 đã viết:
Gái xinh có khác, suy nghĩ cũng hại nào phết nhỉ, người ta hỏi tách bạch là ("800>=500" ; "1000<300" ), hai biểu thức riêng biệt, chứ có phải là m ột đâu mà nhét chúng vào một mớ chứ.

Bài đã được tự động gộp: 14/6/18

Viết thế là sai cú pháp luôn, chứ 2 3 biểu thức gì trời.

Ồ thế ra là do mình không biết chưa biết cú pháp VBA, lại làm phiền các anh chị, thật ngại quá. hic.

VetMini · 14/6/18

AutoReply đã viết:
mình gõ y nguyên vào rồi mà đâu có được đâu :

Mã:

MsgBox Application.Evaluate("800>=500" ; "1000<300")

Nếu được thì kết quả là cái gì?
Cái biểu thức "800>=500" ; "1000<300" ông cố Pi ta go, Ơ cơ lit, Dề cát còn chưa hiểu nữa chứ đừng nói cái thằng đần VBA.

ngokylanvnn12 · 14/6/18

Các bạn giúp mình với, mình mới nghiên cứu excel nên cũng còn gà, mình lập 1 cái userform gồm có:
+ 2 Nút nhấn : thêm và thêm mới.
+ 1 lisboxt mình dùng definame đưa vào listbox và đặt tên là "DSD" (ở phần rowsouce mình điền "DSD" mình chỉ biết dùng cách này thôi các bạn có cách khác hay hơn xin hướng dẫn dùm)
+ 4 textboxt: 1 cái là dùng để tìm kiếm dữ liệu nhanh từ listbox, 3 cái còn lại để thêm mới vào dữ liệu trong "DSD"
mình muốn viết code như sau:
sau khi add dữ liệu vào listboxt thì nhấn nút "THÊM" dữ liệu trên listbox sẽ nạp nhu sau:
+Cột "DANH MỤC" trong listbox sẽ nộp vào cột B phía dưới hàng có tên "SCOPE OF WORK" trong sheet "ELECTRICAL SYSTEM".
+Cột "VẬT TƯ" trong listbox sẽ nộp vào cột M phía dưới hàng có tên "MATERIAL" trong sheet "ELECTRICAL SYSTEM".
+Cột "NHÂN CÔNG" trong listbox sẽ nộp vào cột N phía dưới hàng có tên "LABOUR" trong sheet "ELECTRICAL SYSTEM".
khi nạp vào như vậy thì sẽ tự động nạp vào dòng tiếp theo.
+ khi chọn mục để nạp mình có thể chọn được nhiều mục để nạp cùng lúc.
- 3 ô Texbox khi nhập dữ liệu vào 3 ô, khi nhấn nút "THÊM" dữ liệu sẽ được nạp mới vào dòng tiếp theo của "DSD".
- ô tìm kiếm khi gõ vào ký tự cần tìm thì listbox chỉ xuất hiện những mục mình cần nạp.
- Mình muốn tạo thêm 1 combobox sử dụng userform để nạp cho các sheet còn lại, khi chọn sheet nào trên userform thì sẽ di chuyển đến sheet đó và nhập liệu.(mình chưa tạo combobox).
Thanks mọi người!

joinatz · 15/6/18

XIN GIÚP ĐỠ !!!
Tôi có tập tành viết 1 form nhập liệu đơn giản (tôi rất gà mờ về Excel và VBA), hiện tại nó đã chạy được nhưng còn 1 chổ tôi chưa xử lý được xin mọi người giúp tôi với:
nó như vầy:

khi tôi xóa dòng trên lưới thì số thứ tự không tính lại

code "đưa xuống lưới":
Private Sub Cmd_duaxuongluoi_Click()
Dim i As Byte, j As Long
For i = 1 To 4
Next
If Congviec = "" Then
MsgBox "Ban chua nhap Cong viec", vbOKOnly + vbInformation, "THÔNG BÁO"
End If
With ListBox3
j = .ListCount
.AddItem j + 1
.List(j, 1) = MaÐV
.List(j, 2) = Donvi
.List(j, 3) = Diachi
.List(j, 4) = Congviec
End With
TextBox1 = "" : MaÐV = "" : Donvi = "" : Congviec = "" : Diachi = ""
End Sub

code "xóa dòng trên lưới":
Private Sub Cmd_xoadong_Click()
With Me.ListBox3
Dim i As Long
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) = True Then
.RemoveItem i
End If
'-------- thu nhieu cach khong chay -----------
Next i
End With
End Sub

Tất cả code trên tôi đều học và mày mò trên GPE, chân thành cám ơn các Thầy và các bạn

Mong được mọi người giúp đỡ.

Lần đầu viết bài nên nếu có sai xót xin bỏ qua. Cám ơn ./.

♫ђöล♥ßล†♥†µ♫ · 15/6/18

joinatz đã viết:
XIN GIÚP ĐỠ !!!
Tôi có tập tành viết 1 form nhập liệu đơn giản (tôi rất gà mờ về Excel và VBA), hiện tại nó đã chạy được nhưng còn 1 chổ tôi chưa xử lý được xin mọi người giúp tôi với:
nó như vầy:
View attachment 197491
khi tôi xóa dòng trên lưới thì số thứ tự không tính lại
View attachment 197492
code "đưa xuống lưới":
Private Sub Cmd_duaxuongluoi_Click()
Dim i As Byte, j As Long
For i = 1 To 4
Next
If Congviec = "" Then
MsgBox "Ban chua nhap Cong viec", vbOKOnly + vbInformation, "THÔNG BÁO"
End If
With ListBox3
j = .ListCount
.AddItem j + 1
.List(j, 1) = MaÐV
.List(j, 2) = Donvi
.List(j, 3) = Diachi
.List(j, 4) = Congviec
End With
TextBox1 = "" : MaÐV = "" : Donvi = "" : Congviec = "" : Diachi = ""
End Sub

code "xóa dòng trên lưới":
Private Sub Cmd_xoadong_Click()
With Me.ListBox3
Dim i As Long
For i = .ListCount - 1 To 0 Step -1
If .Selected(i) = True Then
.RemoveItem i
End If
'-------- thu nhieu cach khong chay -----------
Next i
End With
End Sub

Tất cả code trên tôi đều học và mày mò trên GPE, chân thành cám ơn các Thầy và các bạn

Mong được mọi người giúp đỡ.

Lần đầu viết bài nên nếu có sai xót xin bỏ qua. Cám ơn ./.

Sao cái Form này quen quá nhỉ. Cái này bạn phải đính kèm file nên rồi

joinatz · 15/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Sao cái Form này quen quá nhỉ. Cái này bạn phải đính kèm file nên rồi

Thì đúng rồi. Tôi có nói ở trên là tôi học và làm được tất cả là từ GPE mà.
còn cái form thì tôi sử dụng nguồn bài viết tạo phiếu bán hàng của anh Hòang Trọng Nghĩa. Xin cám ơn anh.

Hiện tại tôi đang ra ngoài nên không gởi file lên được, lát tôi về cty tôi gởi lên.

Chân thành cám ơn sự quan tâm và giúp đỡ.

joinatz · 15/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Sao cái Form này quen quá nhỉ. Cái này bạn phải đính kèm file nên rồi

Đây là file tôi làm, nhờ bạn xem và hổ trợ giúp

cám ơn nhiều

♫ђöล♥ßล†♥†µ♫ · 15/6/18

joinatz đã viết:
Đây là file tôi làm, nhờ bạn xem và hổ trợ giúp

cám ơn nhiều

Tạm thời chữa cháy bằng cách này. Bạn xem thử

Sunbinsuzin · 15/6/18

Nhờ mấy bác trên diễn đàn giải thích dùm em code này với! Em ko hiểu tác giả kêu chuyền biến vào hàm như thế nào và thứ tự ra sao.
Nếu được thì cho em xin cái FILE ví dụ với ạ.
Code1

Option Explicit
Function FindTwoCondition(Table As Range, Val1 As Variant, _
Val2 As Variant, Val2Col As Integer, ResultCol As Integer, Optional Val1Occrnce As Integer = 1)
'Tabel Là Bang Du Lieu '
'Val1 Dièu Kien Tìm Thú Nhát '
'Val2 Dièu Kien Thú Hai '
'Val2Col Chi Só Cot Cua Dièu Kien Thú 2 '
'ResultCol Chi Só Cua Cot Càn Dò Tìm '
'Val1Occrnce Giá Tri Thú N Cua Dièu Kien Trong Cot '

Dim i As Integer, iCount As Integer
Dim rCol As Range

For i = 1 To Table.Rows.Count
If Table.Cells(i, 1) = Val1 And Table.Cells(i, Val2Col) = Val2 Then
iCount = iCount + 1
End If
If iCount = Val1Occrnce Then
FindTwoCondition = Table.Cells(i, ResultCol)
Exit For
End If
Next i
End Function

joinatz · 16/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Tạm thời chữa cháy bằng cách này. Bạn xem thử

Cảm ơn bạn rất nhiều

Tôi test thấy nó chạy rất chuẩn và chính xác.
Có gì thắc mắc tôi nhờ bạn giúp tôi nhé. tks

mtuan · 16/6/18

mtuan đã viết:
Bài đã được tự động gộp: 12/6/18

Code ok rồi Anh quá tuyệt
Chân thành cảm ơn Anh

Bài đã được tự động gộp: 16/6/18

giaiphap đã viết:
Tiền tệ cột nào bạn và bị lỗi ra sao?

Chào Giaiphap
Làm phiền A tí được không ạ.
E có đổi chút dữ liệu các cột nhưng trình độ chưa dịch hết code của A nên rối quá.
nhờ A sửa lại code tí sao cho e lọc được các dữ liệu theo tieu đề cột trong sheet DATA NHAP sang sheet BANGKETIEN TT THEO NGAY.
Trong sheet bangke có các cột Quy khô theo TSC và quy khô theo DRC có công thức, và đơn giá có trợ giá va cộ tổng thành tiền.
Phần tô màu đỏ, sao e đổi icol(....) thì treo code không làm việc luôn A. khi đó các flie khác có ct thì copy ko được luôn.
A giúp e lần nữa nha. Cảm ơn A

SA_DQ · 17/6/18

Chào MTuan, post: 862947, member: 107717

Sao tên trang tính fải lê thê làm vậy; Không xài tiếng Việt có dấu trong nớ có được chăng?

Mà trong file mở ra có thấy 'miếng' Code nào đâu mà dò ra chổ đúng sai!

giaiphap · 17/6/18

mtuan đã viết:
Bài đã được tự động gộp: 16/6/18

Chào Giaiphap
Làm phiền A tí được không ạ.
E có đổi chút dữ liệu các cột nhưng trình độ chưa dịch hết code của A nên rối quá.
nhờ A sửa lại code tí sao cho e lọc được các dữ liệu theo tieu đề cột trong sheet DATA NHAP sang sheet BANGKETIEN TT THEO NGAY.
Trong sheet bangke có các cột Quy khô theo TSC và quy khô theo DRC có công thức, và đơn giá có trợ giá va cộ tổng thành tiền.
Phần tô màu đỏ, sao e đổi icol(....) thì treo code không làm việc luôn A. khi đó các flie khác có ct thì copy ko được luôn.
A giúp e lần nữa nha. Cảm ơn A

Tôi thật sự không còn kiên nhẫn để giúp bạn nửa, đã hỏi kỷ bạn ở bài trên rồi, xem lại còn chổ nào chưa ổn nửa không để giúp lần một, giúp xong lại phát sinh, bạn còn bảo tự phát triển code được. Thôi thì lần cuối nhé, xem lại và khẳng định còn sửa gì nửa không?

mtuan · 17/6/18

giaiphap đã viết:
Tôi thật sự không còn kiên nhẫn để giúp bạn nửa, đã hỏi kỷ bạn ở bài trên rồi, xem lại còn chổ nào chưa ổn nửa không để giúp lần một, giúp xong lại phát sinh, bạn còn bảo tự phát triển code được. Thôi thì lần cuối nhé, xem lại và khẳng định còn sửa gì nửa không?

Dạ chào giaiphap
Mong A thông cảm. trước giờ e làm tay và dò bằng vlookup ra dc bảng kê nhưng quá chậm. Nay có A giúp nên muốn tahy đổi mẫu luôn vì trước đây cũng muố thay đổi mẫu rồi nhưng sợ sửa công thức có dc ko nữa nên vẫn áp dụng vậy mà xài.
Nay nhờ có A giúp đỡ code nên em tiến hành đổi mẫu. ban đầu như thế nhưng khi trao đổi cùng ace làm chung thì mẫu có chút thay đổi.
E cũng ngại quá mấy ngày nay ko dám gửi file nhờ A do code sau cùng của A thì quá tuyệt ko cần điều chỉnh theo mẫu trước. Nhưng thôi phiền A giúp trót em lần cuối cho xong. tại em đang học VB mà chưa đến đâu nên chưa phát triển dc A à.
em gửi file lên rồi nhờ A xem có sheet tonghop nếu dc A giúp em luôn nha.
Mong là phiền lần nữa A đừng giận. CẢm ơn rất nhiều

Bài đã được tự động gộp: 17/6/18

SA_DQ đã viết:
Sao tên trang tính fải lê thê làm vậy; Không xài tiếng Việt có dấu trong nớ có được chăng?

Mà trong file mở ra có thấy 'miếng' Code nào đâu mà dò ra chổ đúng sai!

Dạ code viết trong VB của Sheet nha A. vào VB bDclick vào sheet A sẽ thấy
Cảm ơn Anh

Sunbinsuzin · 17/6/18

Ba Tê đã viết:

Thử chạy code này:

PHP:

Public Sub Update_CSDL()
Dim sArr(), tArr(), I As Long, J As Long, Rws As Long, R As Long, Txt As String
tArr = Sheets("Thongtin").Range("A2", Sheets("Thongtin").Range("A2").End(xlDown)).Resize(, 45).Value
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(tArr)
        .Item(tArr(I, 1) & "#" & tArr(I, 2)) = I
    Next I
    sArr = Sheets("CSDL").Range("A2", Sheets("CSDL").Range("A2").End(xlDown)).Resize(, 45).Value
    R = UBound(sArr)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 2)
        If .Exists(Txt) Then
            Rws = .Item(Txt)
            For J = 13 To 32
                sArr(I, J) = tArr(Rws, J)
            Next J
        End If
    Next I
End With
Sheets("CSDL").Range("A2").Resize(R, 45) = sArr
End Sub

Em mới tập tành viết code vba bác có thể chú thích cho em ý nghĩa của đoạn code mà bác viết ở trên được ko ạ.
Cám ơn bác

themorzer · 17/6/18

Mọi người giúp đỡ làm thế nào để k hiện dòng rỗng trên ListBox,

list box trên có thanh trượt và dòng rỗng, mình đã add thêm điều kiện loại dòng rỗng mà không được
tham khao đính kèm
thanks

♫ђöล♥ßล†♥†µ♫ · 17/6/18

themorzer đã viết:
Mọi người giúp đỡ làm thế nào để k hiện dòng rỗng trên ListBox, View attachment 197596
list box trên có thanh trượt và dòng rỗng, mình đã add thêm điều kiện loại dòng rỗng mà không được
tham khao đính kèm
Cảm ơn

Bạn xem thử

Hau151978 · 17/6/18

themorzer đã viết:
Mọi người giúp đỡ làm thế nào để k hiện dòng rỗng trên ListBox, list box trên có thanh trượt và dòng rỗng, mình đã add thêm điều kiện loại dòng rỗng mà không được
Cảm ơn

Trong khai báo mảng aDes vì bạn chưa biết kích thước của nó nên bạn khai báo thành 60000 dòng, tuy nhiên VBA chỉ cho phép định lại kích cỡ chiều cuối cùng của mảng nhiều chiều nên bạn không thể xóa dòng trống bằng Redim Preserve được. Để khắc phục điều này thì dễ nhất là dùng Dictionary, load các key và số lượng vào dic, công việc này chỉ làm lần đầu tiên khi bắt đầu chương trình, các key tìm được cũng dùng để đưa vào combobox luôn, sau này có thêm bớt các key NOS G, NOS K... không cần sửa lại code nữa.

giaiphap · 17/6/18

mtuan đã viết:
Dạ chào giaiphap
Mong A thông cảm. trước giờ e làm tay và dò bằng vlookup ra dc bảng kê nhưng quá chậm. Nay có A giúp nên muốn tahy đổi mẫu luôn vì trước đây cũng muố thay đổi mẫu rồi nhưng sợ sửa công thức có dc ko nữa nên vẫn áp dụng vậy mà xài.
Nay nhờ có A giúp đỡ code nên em tiến hành đổi mẫu. ban đầu như thế nhưng khi trao đổi cùng ace làm chung thì mẫu có chút thay đổi.
E cũng ngại quá mấy ngày nay ko dám gửi file nhờ A do code sau cùng của A thì quá tuyệt ko cần điều chỉnh theo mẫu trước. Nhưng thôi phiền A giúp trót em lần cuối cho xong. tại em đang học VB mà chưa đến đâu nên chưa phát triển dc A à.
em gửi file lên rồi nhờ A xem có sheet tonghop nếu dc A giúp em luôn nha.
Mong là phiền lần nữa A đừng giận. CẢm ơn rất nhiều

Bài đã được tự động gộp: 17/6/18

Dạ code viết trong VB của Sheet nha A. vào VB bDclick vào sheet A sẽ thấy
Cảm ơn Anh

Sửa code như sau:

Rich (BB code):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet10.Range("A2:P" & Sheet10.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 10, 11, 14, 3, 8, 25, 1, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay = Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) = 3 Then
                    dArr(k, j + 1) = (dArr(k, j) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 8 Then
                    dArr(k, j + 1) = (dArr(k, j - 3) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 1 Then
                     dArr(k, j + 1) = dArr(k, j - 5) * dArr(k, j - 1) * dArr(k, j)
                Else
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 14)).Sort Key1:=.Range("M14:M" & (k + 14)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("I" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -3).Address, "$", "") & ")"
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 8).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C9:R[-1]C9)"
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=DocSoAbc(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub

truongvu317 · 17/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn xem thử

Tui cũng không hiểu trên gpe này hình như có một căn bệnh hay sao ý, đó là cứ khi lọc không được hàng dữ liệu nào là ý rằng các bạn cho nó hiện hết dữ liệu ra. Không tìm thấy thì cứ để nó trống trơn có phải hợp lý hơn không?

AutoReply · 17/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn xem thử

Nghe nói em có bệnh hả em ? Nhớ uống thuốc kẻo bệnh nặng thêm nha em. Và điều đầu tiên cần làm là đổi hình đại diện lại nha em :{{

mtuan · 18/6/18

giaiphap đã viết:

Sửa code như sau:

Rich (BB code):

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet10.Range("A2:P" & Sheet10.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 10, 11, 14, 3, 8, 25, 1, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay = Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) = 3 Then
                    dArr(k, j + 1) = (dArr(k, j) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 8 Then
                    dArr(k, j + 1) = (dArr(k, j - 3) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 1 Then
                     dArr(k, j + 1) = dArr(k, j - 5) * dArr(k, j - 1) * dArr(k, j)
                Else
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 14)).Sort Key1:=.Range("M14:M" & (k + 14)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("I" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -3).Address, "$", "") & ")"
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 8).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C9:R[-1]C9)"
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=DocSoAbc(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub

Không biết phải nói thế nào để cảm ơn A. Quá tuyệt
Xin đa tạ.

truongvu317 · 18/6/18

AutoReply đã viết:
Nghe nói em có bệnh hả em ? Nhớ uống thuốc kẻo bệnh nặng thêm nha em. Và điều đầu tiên cần làm là đổi hình đại diện lại nha em

Làm gì có chuyện bạn xinh gái ý có bệnh, bạn lại đoán mò rùi, có cao kiến về code thì phát biểu đi, đừng có nghẹn ngào cả ngày thế.

VetMini · 18/6/18

AutoReply đã viết:
... Và điều đầu tiên cần làm là đổi hình đại diện lại nha em

Rất hữu lý.
Hình đại diện nên cơ róp hết, chỉ còn khuôn mặt thôi, không thể xác định nam nữ mới là đúng mốt.

AutoReply · 18/6/18

truongvu317 đã viết:
Làm gì có chuyện bạn xinh gái ý có bệnh, bạn lại đoán mò rùi, có cao kiến về code thì phát biểu đi, đừng có nghẹn ngào cả ngày thế.

Mình nghe người ta nói bạn ấy có bệnh nên mình quan tâm hỏi thăm người ta, đâu có nói gì đến bạn nhỉ ?
Mình chưa có rành cú pháp VBA nữa thì lấy đâu ra cao kiến để phát biểu hả bạn ? Bạn làm khó mình rồi.

truongvu317 · 18/6/18

AutoReply đã viết:
Mình chưa có rành cú pháp VBA nữa thì lấy đâu ra cao kiến để phát biểu hả bạn ? Bạn làm khó mình rồi.

Có nhất thiết phải biết cú pháp đâu, tui còn chả biết cái vba là cái giống gì mà cứ nói đại đi, chả ai bắt vạ đâu, nhất là gái xinh. Cứ thích làm khó đấy, chủ yếu là kích thích nhau cùng phát triển thui.

joinatz · 18/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Tạm thời chữa cháy bằng cách này. Bạn xem thử

Chào bạn !

Xin cám ơn hôm trước đã giúp tôi code nhé.

Hôm nay có việc này xin nhờ bạn giúp với:
2 cái textbox ngày đi + ngày về :
nhờ bắt lỗi dùm :
+ nếu ngày nhập vào lớn hơn ngày hiện tại
+ nếu ngày về lớn hơn ngày đi
ra thông báo lỗi và con trỏ vẫn nằm tại texbox.

Loay hoay cả ngày Chủ nhật mà làm không được.

Cám ơn bạn rất nhiều.

♫ђöล♥ßล†♥†µ♫ · 18/6/18

joinatz đã viết:
Chào bạn !

Xin cám ơn hôm trước đã giúp tôi code nhé.

Hôm nay có việc này xin nhờ bạn giúp với:
2 cái textbox ngày đi + ngày về :
nhờ bắt lỗi dùm :
+ nếu ngày nhập vào lớn hơn ngày hiện tại
+ nếu ngày về lớn hơn ngày đi
ra thông báo lỗi và con trỏ vẫn nằm tại texbox.

Loay hoay cả ngày Chủ nhật mà làm không được.

Cám ơn bạn rất nhiều.

Ngày về đương nhiên phải lớn hơn ngày đi rồi. Vậy thông báo lỗi gì nữa Bạn
Mà 2 Textbox trong Form đang kiểu như này Format(Me.Ngaydi, "dd/mm/yyyy"), Format(Me.Ngaydi, "dd/mm/yyyy") thì là tì mì ... Vì Textbox nó là Text mờ

Sunbinsuzin · 18/6/18

Em tìm trên diễn đàn được đoạn code ở dưới. Nhưng nếu dữ liệu Table nằm ở 2 sheets thì ko sử dụng được. Em sử lại code nhưng bị báo lỗi mong được các bác hướng dẫn viết lại.
em xin cảm ơn.

Function FindTwoCondition(Table As Range, Val1 As Variant, _
Val2 As Variant, Val2Col As Integer, ResultCol As Integer, Optional Val1Occrnce As Integer = 1)
'Tabel Là Bang Du Lieu '
'Val1 Dièu Kien Tìm Thú Nhát '
'Val2 Dièu Kien Thú Hai '
'Val2Col Chi Só Cot Cua Dièu Kien Thú 2 '
'ResultCol Chi Só Cua Cot Càn Dò Tìm '
'Val1Occrnce Giá Tri Thú N Cua Dièu Kien Trong Cot '

Dim i As Integer, iCount As Integer
Dim rCol As Range

For i = 1 To Table.Rows.Count
If Table.Cells(i, 1) = Val1 And Table.Cells(i, Val2Col) = Val2 Then
iCount = iCount + 1
End If
If iCount = Val1Occrnce Then
FindTwoCondition = Table.Cells(i, ResultCol)
Exit For
End If
Next i
End Function

Function FindTwoCondition(DK1 As Variant, VUNGDK1 As Range, DK1 As Variant, VUNGDK2 As Range, VUNGKQ As Range)
'DK1 Dièu Kien Tìm Thú Nhát
'VUNGDK1 Dièu Kien Tìm Thú Nhát
'DK2 Dièu Kien Thú Hai
'VUNGDK2 Dièu Kien Thú Hai
'VUNGKQ Vung ket qua
Dim i As Integer, iCount As Integer
iCount = VUNGDK1.Rows.Count
For i = 1 To iCount
If VUNGDK1.Cells(i, 1) = Val1 And VUNGDK2.Cells(i, 1) = Val2 Then
FindTwoCondition = VUNGKQ.Cells(i, 1)
End If
Exit For
Next i
End Function

♫ђöล♥ßล†♥†µ♫ · 18/6/18

Sunbinsuzin đã viết:
Em tìm trên diễn đàn được đoạn code ở dưới. Nhưng nếu dữ liệu Table nằm ở 2 sheets thì ko sử dụng được. Em sử lại code nhưng bị báo lỗi mong được các bác hướng dẫn viết lại.
em xin cảm ơn.

Function FindTwoCondition(Table As Range, Val1 As Variant, _
Val2 As Variant, Val2Col As Integer, ResultCol As Integer, Optional Val1Occrnce As Integer = 1)
'Tabel Là Bang Du Lieu '
'Val1 Dièu Kien Tìm Thú Nhát '
'Val2 Dièu Kien Thú Hai '
'Val2Col Chi Só Cot Cua Dièu Kien Thú 2 '
'ResultCol Chi Só Cua Cot Càn Dò Tìm '
'Val1Occrnce Giá Tri Thú N Cua Dièu Kien Trong Cot '

Dim i As Integer, iCount As Integer
Dim rCol As Range

For i = 1 To Table.Rows.Count
If Table.Cells(i, 1) = Val1 And Table.Cells(i, Val2Col) = Val2 Then
iCount = iCount + 1
End If
If iCount = Val1Occrnce Then
FindTwoCondition = Table.Cells(i, ResultCol)
Exit For
End If
Next i
End Function

Function FindTwoCondition(DK1 As Variant, VUNGDK1 As Range, DK1 As Variant, VUNGDK2 As Range, VUNGKQ As Range)
'DK1 Dièu Kien Tìm Thú Nhát
'VUNGDK1 Dièu Kien Tìm Thú Nhát
'DK2 Dièu Kien Thú Hai
'VUNGDK2 Dièu Kien Thú Hai
'VUNGKQ Vung ket qua
Dim i As Integer, iCount As Integer
iCount = VUNGDK1.Rows.Count
For i = 1 To iCount
If VUNGDK1.Cells(i, 1) = Val1 And VUNGDK2.Cells(i, 1) = Val2 Then
FindTwoCondition = VUNGKQ.Cells(i, 1)
End If
Exit For
Next i
End Function

Sao mà hỏi nhiều lần vậy. Cái này người ta gọi là "Phạm quy" đấy
Bạn đưa cái hàm đó nên mà không nói công dụng của nó thì có tời mới hiểu. Vì vậy mà 2 đến 3 bài trước của Bạn không ai trả lời

Sunbinsuzin · 18/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Sao mà hỏi nhiều lần vậy. Cái này người ta gọi là "Phạm quy" đấy
Bạn đưa cái hàm đó nên mà không nói công dụng của nó thì có tời mới hiểu. Vì vậy mà 2 đến 3 bài trước của Bạn không ai trả lời

Dạ em xin rút kinh nghiệm
Code đó là code tìm kiếm với 2 Điều kiện ạ
BÁC giúp em viết lại được ko ạ.
Thank bác

joinatz · 18/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Ngày về đương nhiên phải lớn hơn ngày đi rồi. Vậy thông báo lỗi gì nữa Bạn
Mà 2 Textbox trong Form đang kiểu như này Format(Me.Ngaydi, "dd/mm/yyyy"), Format(Me.Ngaydi, "dd/mm/yyyy") thì là tì mì ... Vì Textbox nó là Text mờ

Xin lỗi, xin lỗi

bị sót cái code ngày về

và viết bị nhầm
+ nếu ngày nhập vào lớn hơn ngày hiện tại -- ra thông báo
+ nếu ngày về nhỏ hơn ngày đi --- ra thông báo

thông cảm bỏ qua và giúp dùm nhé. TKS

Sunbinsuzin · 18/6/18

Sunbinsuzin đã viết:
Dạ em xin rút kinh nghiệm
Code đó là code tìm kiếm với 2 Điều kiện ạ
BÁC giúp em viết lại được ko ạ.
Thank bác

] Em sửa được rồi. Thank all

♫ђöล♥ßล†♥†µ♫ · 18/6/18

joinatz đã viết:
Xin lỗi, xin lỗi

bị sót cái code ngày về

và viết bị nhầm
+ nếu ngày nhập vào lớn hơn ngày hiện tại -- ra thông báo
+ nếu ngày về nhỏ hơn ngày đi --- ra thông báo

thông cảm bỏ qua và giúp dùm nhé. TKS

Bạn xem thử

batman1 · 18/6/18

VetMini đã viết:
Rất hữu lý.
Hình đại diện nên cơ róp hết, chỉ còn khuôn mặt thôi, không thể xác định nam nữ mới là đúng mốt.

Tôi cứ thấy "Khà khà khà" là tôi cho là nam. Sau đó thấy "hihi ^o^" thì là nữ hoặc quên đang diễn vai gì.

lequan2583 · 18/6/18

Nhờ anh ndu96081631 xem giúp
trong bài toán trích lọc danh sách duy nhất và tổng hợp dữ liệu với 2 điều kiện
1. trùng part code
2. trùng Delivery date
thì tổng hợp dữ liệu số lượng (Qty) từ sheet Po sang sheet linkpo như file đính kèm

nhưng trong code hiện tại chưa đáp ứng được điều kiện thứ 2
vì khi xóa dữ liệu ngày ở sheet linkpo từ ô G9 trở đi thì vẫn ra kết quả bình thường
Vậy nhờ anh chị GPE xem sửa giúp code để thỏa mãn cả điều kiện thứ 2

Sub linkpo()

On Error GoTo 1:
Dim Rng(), Arr(), Dic As Object, t, lCal
Dim c As Long, i As Long, K As Long, D As Long, Tem As String
Application.ScreenUpdating = False
lCal = Application.Calculation: Application.Calculation = xlCalculationManual
t = Timer
Const nCol = 1000
Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("linkpo")

K = .[B15000].End(xlUp).Row:
If K > 2 Then .[A10].Resize(K - 2, nCol).ClearContents
D = .[F9].Value
End With

With Sheets("po"): Rng = .Range(.[B5], .[B15000].End(xlUp)).Resize(, 11).Value: End With
ReDim Arr(1 To UBound(Rng, 1), 1 To nCol)
K = 0
For i = 1 To UBound(Rng, 1)
If Rng(i, 10) <> "" Then
c = Rng(i, 10) - D + 6
Tem = Rng(i, 1)
If Dic.Exists(Tem) Then
Arr(Dic.Item(Rng(i, 1)), c) = Arr(Dic.Item(Rng(i, 1)), c) + Rng(i, 11)
Else

K = K + 1: Dic.Add (Tem), K
Arr(K, 1) = K: Arr(K, 3) = Tem: Arr(K, c) = Rng(i, 11)
Arr(K, 4) = Rng(i, 2)

End If
End If

Next i

Set Dic = Nothing
Sheets("linkpo").[A10].Resize(K, nCol).Value = Arr

With Sheets("linkpo")

Range("B10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[1],'Master list'!R2C2:R50C3,2,3,1)"
Range("B10").Select
Selection.AutoFill Destination:=Range("B10:B48")
Range("E10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[-2],'Master list'!R2C3:R50C5,3,2,1)"
Range("E10").Select
Selection.AutoFill Destination:=Range("E10:E48")
Range("B10").Select

End With

1: Application.ScreenUpdating = True: Application.Calculation = lCal

End Sub

joinatz · 18/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn xem thử

Cám ơn bạn rất nhiều.

Để cho chạy thử. Có gì nhờ bạn hỗ trợ.
TKS

truongvu317 · 18/6/18

batman1 đã viết:
Tôi cứ thấy "Khà khà khà" là tôi cho là nam. Sau đó thấy "hihi ^o^" thì là nữ hoặc quên đang diễn vai gì.

Cảm ơn anh nhiều nhá! Giờ em mới biết nguyên tắc xác định giới tính, còn những kinh nghiệm về dùng vba hay gì gì đó anh chia sẻ đi, rất là ưng cái bụng.

taisky990-gpe · 19/6/18

e mới tìm hiểu về vba excell, có đoạn code in theo trang cho từng trường hợp, vd.
Sub INKHDATO()
If Sheets("CM").Range("B1") = "Brian" Then

' your code to print sheets in case of brian
Else
Sheets("CM").PrintOut From:=1, To:=3, Copies:=2, Collate _
:=True, IgnorePrintAreas:=False
Sheets("CM").PrintOut From:=4, To:=4, Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
Sheets("CM").PrintOut From:=5, To:=5, Copies:=2, Collate _
:=True, IgnorePrintAreas:=False
Sheets("CM").PrintOut From:=7, To:=8, Copies:=2, Collate _
:=True, IgnorePrintAreas:=False
Sheets("CM").PrintOut From:=10, To:=11, Copies:=2, Collate _
:=True, IgnorePrintAreas:=False
Sheets("CM").PrintOut From:=12, To:=12, Copies:=2, Collate _
:=True, IgnorePrintAreas:=False
Sheets("CM").PrintOut From:=13, To:=13, Copies:=2, Collate _
:=True, IgnorePrintAreas:=False
End If
End Sub
có pro nào có cách nào gọn hơn, nhanh hơn không ạ, e cảm ơn hj

buithangdz · 19/6/18

Hi các bác,

Em lấy được một đoạn code để tự động save các file đính kèm từ outlook về folder trên máy, nhưng không hiểu vì sao khi chạy thì báo lỗi system error &H8004010F (-2147221233). Các bác xem giúp em với ạ.
Sub sumit()

readMails

End Sub

Function readMails()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace

Dim olItem As Outlook.MailItem
Dim i As Integer
Dim b As Integer
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As Outlook.MAPIFolder
Dim lngCol As Long
Dim oMsg As Outlook.MailItem
Dim SubfolderWB As Workbook
Dim keyword
Dim Path
Dim Count
Dim Atmt
Dim f_random
Dim Filename

Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")

Set SubfolderWB = ActiveWorkbook

Set olInbox = olNamespace.GetDefaultFolder(Outlook.olFolderInbox).Folders(Range("j1").Text)
Dim oItems As Outlook.Items
Set oItems = olInbox.Items
SubfolderWB.Sheets("Subfolder").Range("A:E").Clear
SubfolderWB.Sheets("Subfolder").Range("A1,B1,c1,d1,E1").Interior.ColorIndex = 46
Path = SubfolderWB.Sheets("Subfolder").Range("J5").Value
keyword = SubfolderWB.Sheets("Subfolder").Range("J3").Value
SubfolderWB.Sheets("Subfolder").Range("A1").Value = "Number"
SubfolderWB.Sheets("Subfolder").Range("B1").Value = "Subject"
SubfolderWB.Sheets("Subfolder").Range("C1").Value = "Sender"
SubfolderWB.Sheets("Subfolder").Range("D1").Value = "ReceivedTime"
SubfolderWB.Sheets("Subfolder").Range("A1,B1,c1,d1,e1").Borders.Value = 1
Count = 2
For i = 1 To oItems.Count
If TypeName(oItems.Item(i)) = "MailItem" Then
Set oMsg = oItems.Item(i)

If InStr(1, oMsg.Subject, keyword, vbTextCompare) > 0 And oMsg.ReceivedTime > Now - Range("j7").Value Then

SubfolderWB.Sheets("Subfolder").Range("A" & Count).Value = Count - 1
SubfolderWB.Sheets("Subfolder").Range("B" & Count).Value = oMsg.Subject
SubfolderWB.Sheets("Subfolder").Range("c" & Count).Value = oMsg.SenderName
SubfolderWB.Sheets("Subfolder").Range("D" & Count).Value = oMsg.ReceivedTime

For Each Atmt In oMsg.Attachments
f_random = Replace(Replace(Replace(oMsg.ReceivedTime, " ", ""), "/", ""), ":", "") & "_"
Filename = Path & f_random & Atmt.Filename

Atmt.SaveAsFile Filename
'FnWait (1)

' i = i + 1
Next Atmt
Count = Count + 1
End If
End If

Next

End Function

Huỳnh Đăng Khoa · 19/6/18

Hi mọi người, mình có 1 file gởi email bảng lương, trong lúc làm thì phát sinh lỗi ở phần xuất ra file Excel. mình đính kèm file, mọi người xem giúp mình với ^_^

QUYTT2 · 19/6/18

Xin chào các anh/chị/em, e đang có một số thắc mắc về Function trong VBA, xin nhờ các tiền bối chỉ giáo giúp em:
+ Hàm trong excel được viết bằng ngôn ngữ gì? Có cách nào mình xem được code của các hàm đó không ạ.
+ Khi viết Function trong VBA, có cách nào để khi sử dụng Function này ngoài bảng tính excel thì khi gõ tên hàm sẽ hiện lên các gợi ý về tham số của hàm như hàm Excel không ạ.
Em xin cảm ơn.

truongvu317 · 19/6/18

QUYTT2 đã viết:
ngôn ngữ gì

Ngôn ngữ gì thì không biết, nhưng sẽ không x em được code bởi nó đã được dịch thành mã máy.

QUYTT2 đã viết:
hàm sẽ hiện lên các gợi ý về tham số của hàm như hàm Excel không ạ.

Cái này hình như làm được, nhưng phức tạp thì phải.

Bài đã được tự động gộp: 19/6/18

QUYTT2 đã viết:
ngôn ngữ gì

Ngôn ngữ gì thì không biết, nhưng sẽ không x em được code bởi nó đã được dịch thành mã máy.

QUYTT2 đã viết:
hàm sẽ hiện lên các gợi ý về tham số của hàm như hàm Excel không ạ.

Cái này hình như làm được, nhưng phức tạp thì phải.

VetMini · 19/6/18

QUYTT2 đã viết:
Xin chào các anh/chị/em, e đang có một số thắc mắc về Function trong VBA, xin nhờ các tiền bối chỉ giáo giúp em:
+ Hàm trong excel được viết bằng ngôn ngữ gì? Có cách nào mình xem được code của các hàm đó không ạ.
...

Mắc mớ gì chào anh/chị/em mà nhờ thì lại "tiền bối", chỉ giáo với chỉ gươm.
Hầu hết các phần mềm của MS Office 2003, nhất là Excel, được viết bằng C++. Nhưng về sau này, MS có khuynh hướng dùng Víual Studio và rèactor code lại cho hiệu quả. (Cho đến giờ phút này, C++ vẫn còn đứng đầu về tốc độ.)
Microsoft không có lệ cho xem mã. Và họ có cầu chứng cho nên dẫu có dùng cách mò ngược (reverse enginneering) thì cũng là phạm pháp. Tuy nhiên, nếu chỉ muốn xem đại khái cách thực hiện hàm thì có thể xem tạm mã nguồn mở, ví dụ LibreOffice.

QUYTT2 · 19/6/18

VetMini đã viết:
Mắc mớ gì chào anh/chị/em mà nhờ thì lại "tiền bối", chỉ giáo với chỉ gươm.
Hầu hết các phần mềm của MS Office 2003, nhất là Excel, được viết bằng C++. Nhưng về sau này, MS có khuynh hướng dùng Víual Studio và rèactor code lại cho hiệu quả. (Cho đến giờ phút này, C++ vẫn còn đứng đầu về tốc độ.)
Microsoft không có lệ cho xem mã. Và họ có cầu chứng cho nên dẫu có dùng cách mò ngược (reverse enginneering) thì cũng là phạm pháp. Tuy nhiên, nếu chỉ muốn xem đại khái cách thực hiện hàm thì có thể xem tạm mã nguồn mở, ví dụ LibreOffice.

dạ, em cảm ơn ạ. VietMini cho em hỏi luôn vấn đề này với ạ, em muốn tự viết 1 Function để tính Tổng theo điều kiện (có thêm 1 vài tham số nữa nên k chỉ đơn thuần gọi sumif trong excel được), em đg vướng chỗ xử lý điều kiện người dùng nhập vào như <=/>=/</> ... 1 số . Viết bằng cách gọi hàm Sumif phối hợp để xử lý thì em viết được rồi. Nhưng Em đang thắc mắc về cách để mình tự xử lý những điều kiện này. Nhờ a giúp đỡ

Bài đã được tự động gộp: 19/6/18

Cái này hình như làm được, nhưng phức tạp thì phải.[/QUOTE]

Dạ em cảm ơn TruongVu317 ạ. Nếu làm được thì tốt a nhỉ, chứ k thì chỉ có mình viết mình mới biết cần tham số gì, số lượng tham số trong hàm, đưa cho người khác thì phải hướng dẫn cách dùng cụ thể.

VetMini · 19/6/18

QUYTT2 đã viết:
... em đg vướng chỗ xử lý điều kiện người dùng nhập vào như <=/>=/</> ... 1 số . Viết bằng cách gọi hàm Sumif phối hợp để xử lý thì em viết được rồi. Nhưng Em đang thắc mắc về cách để mình tự xử lý những điều kiện này.

Cái này hơi phức tạp. Phải có kiến thức về nguyên tắc sử lý của trình duyệt.

QUYTT2 đã viết:
chứ k thì chỉ có mình viết mình mới biết cần tham số gì, số lượng tham số trong hàm, đưa cho người khác thì phải hướng dẫn cách dùng cụ thể.

Hàm phức tạp đương nhiên phải hướng dẫn cách dùng cụ thể. Không có đường nào khác.
Cái phần gợi ý là để nhắc cho chính mình - có cỡ vài chục cái hàm thì ai mà nhớ cho hết. Chứ bảo ngừoi dùng đọc một vài dòng mà hiểu nổi thì bạn đánh giá hơi cao khả năng vắn tắt diễn đạt của mình đấy.

batman1 · 20/6/18

Ngay các hàm Excel cũng phải đọc để hiểu hàm làm gì, ý nghĩa và cách dùng các tham số v...v Tự dưng thì làm sao biết được.

Hàm người dùng cũng tương tự. Phải đọc mới biết chứ làm sao tự biết được?
Tất nhiên nếu không có mô tả kỹ lưỡng thì ít ra cũng phải có mô tả ngắn gọn về triết lý của hàm, các tham số. Người dùng chỉ cần hiểu và sử dụng hàm. Nhưng để người ta có thể hiểu kỹ hơn và chỉnh sửa theo nhu cầu thì nên có chú thích, càng nhiều càng tốt.

Ví dụ về thêm mô tả vào cửa sổ Insert Function trong tập tin

Về gợi ý ở thanh công thức thì tôi không biết. Nếu chưa quen thì dùng Insert Function thôi.

QUYTT2 · 20/6/18

Hàm phức tạp đương nhiên phải hướng dẫn cách dùng cụ thể. Không có đường nào khác.
Cái phần gợi ý là để nhắc cho chính mình - có cỡ vài chục cái hàm thì ai mà nhớ cho hết.

Vâng ạ. Em có tìm rất nhiều về mấy thắc mắc này mà không thấy ai viết, chỉ sợ có mà mình k biết để sử dụng thì mất công quá. Sau khi nghe các anh giải thích thì hiểu ra vấn đề rồi. Em cảm ơn nhiều ạ.

QUYTT2 · 20/6/18

[QUOTE="batman1]
Ví dụ về thêm mô tả vào cửa sổ Insert Function trong tập tin
Về gợi ý ở thanh công thức thì tôi không biết. Nếu chưa quen thì dùng Insert Function thôi.[/QUOTE]

Xem đi xem lại mấy lần mới hiểu ý Bạn viết, k nghĩ đến cái sự kiện wb_open. Cái này giờ mình mới biết, có cái này cũng tốt rồi. Cảm ơn Bạn nhé

honey_552911 · 21/6/18

Xin chào mọi người,
Em có 1 file tạo cơ sở dữ liệu mã vật tư, sử dụng chủ yếu là Data validation, và hàm dò tìm vlookup, index(match). Nhưng dữ liệu lên tới 8000 dòng, liên kết nhiều sheet nên công thức chạy rất lâu. Em mong mọi người giúp đỡ để cải thiện file. Chi tiết em đã note trong từng sheet (màu đen) ạ.
Cảm ơn mọi người.

honey_552911 · 21/6/18

Mọi người ơi giúp em với

aries8214 · 22/6/18

honey_552911 đã viết:
Mọi người ơi giúp em với

Theo mình biết thì đối với CSDL lớn thì không nên dùng excel mà dùng các phần mềm chuyên dùng để quản lí CSDL khác. Hoặc bạn có thể dùng SQL trong excel, bạn thử tìm hiểu về addin Atools xem.

honey_552911 · 22/6/18

aries8214 đã viết:
Theo mình biết thì đối với CSDL lớn thì không nên dùng excel mà dùng các phần mềm chuyên dùng để quản lí CSDL khác. Hoặc bạn có thể dùng SQL trong excel, bạn thử tìm hiểu về addin Atools xem.

Cảm ơn bạn,
Do bên mình vừa thay đổi quy trình làm việc, nên xây dựng CSDL trên excel để cung cấp cho bên viết phần mềm. Công việc thật sự rất bận, nên anh chị nào có thể giúp đỡ Code VBA để giải quyết trong khi chờ phần mềm thì tốt quá.

ipadvietnam3 · 22/6/18

các bạn ơi giúp mình với mình có file vba trước chạy win 7 32 bit thì vẫn bình thường nhưng từ hôm mình cài win8.1 64 bit thì không chạy được
mong các bạn giúp mình với
mình chạy file vba với dữ liệu ở trên thì bị 2 lỗi sau mà không biết cách xử lý :

lỗi thứ 2 :

file vba:
http://www.mediafire.com/file/kksqb283qaby627/Xu ly File - Ghi De - Cong Thuc .xlsm
file excel cần:
http://www.mediafire.com/file/262dnc6ddu56vo5/1Goc.xls
file excel sua:
http://www.mediafire.com/file/2bal4cap7y740a5/file can sua.rar

tq_thuyet · 24/6/18

Em muốn lọc nhiều điều kiện trên một cột như dưới nhưng nó báo lỗi.
Các bác chỉ giúp em sai chỗ nào ạ.

Sub Macro2()
Range("A1

1").AutoFilter
ActiveSheet.Range("$A$1:$P$465").AutoFilter Field:=3, Criteria1:= _
"=*BALL RETAINER*", Operator:=xlOr, Criteria2:= _
"=*END PLATE*", Operator:=xlOr, Criteria3:= _
"=*PIPE*"
End Sub

phulien1902 · 25/6/18

tq_thuyet đã viết:
Em muốn lọc nhiều điều kiện trên một cột như dưới nhưng nó báo lỗi.
Các bác chỉ giúp em sai chỗ nào ạ.

Sub Macro2()
Range("A11").AutoFilter
ActiveSheet.Range("$A$1:$P$465").AutoFilter Field:=3, Criteria1:= _
"=*BALL RETAINER*", Operator:=xlOr, Criteria2:= _
"=*END PLATE*", Operator:=xlOr, Criteria3:= _
"=*PIPE*"
End Sub

Thử:

PHP:

Range("A1:p1").AutoFilter
ActiveSheet.Range("$A$1:$P$465").AutoFilter Field:=3, Criteria1:=Array("*BALL RETAINER*", "*END PLATE*", "*PIPE*"), Operator:=xlFilterValues

AutoReply · 25/6/18

ipadvietnam3 đã viết:
các bạn ơi giúp mình với mình có file vba trước chạy win 7 32 bit thì vẫn bình thường nhưng từ hôm mình cài win8.1 64 bit thì không chạy được
mong các bạn giúp mình với
mình chạy file vba với dữ liệu ở trên thì bị 2 lỗi sau mà không biết cách xử lý :
View attachment 197965
lỗi thứ 2 :
View attachment 197966
file vba:
http://www.mediafire.com/file/kksqb283qaby627/Xu ly File - Ghi De - Cong Thuc .xlsm
file excel cần:
http://www.mediafire.com/file/262dnc6ddu56vo5/1Goc.xls
file excel sua:
http://www.mediafire.com/file/2bal4cap7y740a5/file can sua.rar

Bạn Vào Tools -> References sẽ thấy dòng MISSING, gỡ check dòng đó.

truongvu317 · 25/6/18

AutoReply đã viết:
Bạn Vào Tools -> References sẽ thấy dòng MISSING, gỡ check dòng đó.

Bạn gái xinh đẹp cho hỏi còn cách khác nào nữa không?

AutoReply · 25/6/18

truongvu317 đã viết:
Bạn gái xinh đẹp cho hỏi còn cách khác nào nữa không?

Mình không biết.

VetMini · 25/6/18

Xinh đẹp thì có thể, nhưng bạn gái thì chưa chắc.
Thứ nhất, chưa có gì khẳng định giới tính, đờn ông, đờn bà, hay còn ở giữa - chưa chuyển.
Thứ hai, chưa có gì khẳng định là dậy thì hay sồn sồn.

joinatz · 25/6/18

♫ђöล♥ßล†♥†µ♫ đã viết:
Bạn xem thử

Chân thành cám ơn bạn đã nhiệt tình hổ trợ

cái code hôm trước bạn giúp vẫn còn trục trặc tí nhưng mình đã kiếm cách bỏ qua luôn rùi. bây giờ tạm thời nó chạy ổn định.

Mình cám ơn bạn nhiều. nếu có gì thắc mắc nhờ bạn hổ trợ nhé.

TKS!

Sunbinsuzin · 25/6/18

Em nhờ các bác sửa lại code dò tìm 6 điều kiện hộ em với ạ vì em viết nó chạy chậm quá ạ

Function TK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, _
VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
Dim I As Integer, iCount As Integer
iCount = VUNGDK1.Rows.Count
For I = 1 To iCount
If UCase(VUNGDK1.Cells(I, 1)) + UCase(VUNGDK2.Cells(I, 1)) = UCase(DK1) + UCase(DK2) Then
If UCase(VUNGDK3.Cells(I, 1)) = UCase(DK3) Then
If UCase(VUNGDK4.Cells(I, 1)) = UCase(DK4) Then
If UCase(VUNGDK5.Cells(I, 1)) = UCase(DK5) Then
If UCase(VUNGDK6.Cells(I, 1)) = UCase(DK6) Then
TK6DK = VUNGKQ.Cells(I, 1)
Exit For
End If
End If
End If
End If
End If
Next I
End Function

batman1 · 25/6/18

truongvu317 đã viết:
Bạn gái xinh đẹp cho hỏi còn cách khác nào nữa không?

Ai lại đi nhìn ảnh? Ảnh thế nhưng lúc quên vẫn khà khà khà như thường.

AutoReply · 25/6/18

batman1 đã viết:
Ai lại đi nhìn ảnh? Ảnh thế nhưng lúc quên vẫn khà khà khà như thường.

Ấy sao lại là quên vậy bạn ? Người ta đâu có ý định "diễn" đâu bạn. Chỉ là ai gọi bằng gì cũng trả lời, miễn đừng kêu bằng thằng/con quỷ cái là được rồi.

batman1 · 25/6/18

AutoReply đã viết:
Ấy sao lại là quên vậy bạn ? Người ta đâu có ý định "diễn" đâu bạn. Chỉ là ai gọi bằng gì cũng trả lời, miễn đừng kêu bằng thằng/con quỷ cái là được rồi.

Cái đó là viết về "nguyên tắc" chung, không nói cụ thể ảnh của ai. Chả nhẽ nhìn ảnh đứa bé đang bò thì lại viết "bé làm thế là sẽ có lỗi nhé"?

jialink · 25/6/18

Nhờ mọi người gỡ rối cho mình đoạn code này với:
Sub Macro1()
For x = 1 To 2
Selection.EntireRow.Insert
Selection.EntireRow.Insert
SendKeys "{down}"
SendKeys "{down}"
SendKeys "{down}"
Next x
End Sub
Mình muốn đặt chuột ở cell A2 rồi chạy code để tự động insert thêm 2 hàng, sau đó tự động trỏ xuống 3 hàng và thực hiện lại...
Nhưng khi mình dùng code trên thì SendKeys "{down}" lại được thực hiện riêng với Selection.EntireRow.Insert
Mình có gửi kèm file
MONG MỌI NGƯỜI GIÚP ĐỠ, CẢM ƠN NHIỀU NHÉ!!!!!!!!!!!

SA_DQ · 25/6/18

Sunbinsuzin đã viết:
Em nhờ các bác sửa lại code dò tìm 6 điều kiện hộ em với ạ vì em viết nó chạy chậm quá ạ
Function TK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, _
VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
' . . . . . . . . '
End Function

Kiểu này nên có file thì may ra có đáp án cho bạn.

Sunbinsuzin · 25/6/18

SA_DQ đã viết:
Kiểu này nên có file thì may ra có đáp án cho bạn.

Dạ để mai em UP file a.
Thank bác

giaiphap · 25/6/18

jialink đã viết:
Nhờ mọi người gỡ rối cho mình đoạn code này với:
Sub Macro1()
For x = 1 To 2
Selection.EntireRow.Insert
Selection.EntireRow.Insert
SendKeys "{down}"
SendKeys "{down}"
SendKeys "{down}"
Next x
End Sub
Mình muốn đặt chuột ở cell A2 rồi chạy code để tự động insert thêm 2 hàng, sau đó tự động trỏ xuống 3 hàng và thực hiện lại...
Nhưng khi mình dùng code trên thì SendKeys "{down}" lại được thực hiện riêng với Selection.EntireRow.Insert
Mình có gửi kèm file
MONG MỌI NGƯỜI GIÚP ĐỠ, CẢM ƠN NHIỀU NHÉ!!!!!!!!!!!

Tốt nhất bạn nên mô tả kỷ lại vấn đề và sẽ tốt hơn nửa là nên có thêm sheet trước khi chạy code và sheet sau khi chạy code.

truongvu317 · 25/6/18

VetMini đã viết:
Xinh đẹp thì có thể, nhưng bạn gái thì chưa chắc.

batman1 đã viết:
Ảnh thế nhưng lúc quên vẫn khà khà khà như thường.

Xin nhận khuyết điểm là em quá ngây thơ khi nhìn ảnh.

Sunbinsuzin đã viết:
TK6DK = VUNGKQ.Cells(I, 1)

Cái hàm bạn muốn viết nó tính toán cái gì vậy mà ghê thế, đưa file lên.

Miccpro · 26/6/18

Nhờ mọi người giúp em 3 vòng for này với

Mã:

Sub Ba_vong_lap()
Dim i As Long, j As Long, n As Long
Dim Bol As Boolean
For j = 4 To 7
For n = 7 To 13
For i = 2 To 26

If Sheet1.Cells(n, j) <> "" And Sheet1.Cells(n, 3) & Sheet1.Cells(n, j) = Sheet2.Cells(i, 9) & Sheet2.Cells(i, 10).Value Then Bol = true

Next i
if Bol = False then  Sheet1.Cells(n, j) = "Sai"
Next n
Next j
end sub

Nếu em đưa

Mã:

if Bol = False then  Sheet1.Cells(n, j) = "Sai"

vào trong vòng For i thì nó thay hết các giá trị, ngược lại như trên thì nó chỉ thay được nếu giá trị đầu tiên thỏa mãn điều kiện
Em xin cảm ơn

befaint · 26/6/18

Miccpro đã viết:
Nhờ

Gửi file lên xem nào: Cho gì, cần gì và kết quả minh họa. Có hơn 100 bài viết rồi mà...

Miccpro đã viết:
Sheet1.Cells(n, 3) & Sheet1.Cells(n, j) = Sheet2.Cells(i, 9) & Sheet2.Cells(i, 10).Value

1&39 == 13&9 thì làm sao?

Chỗ thì không có, chỗ thì có màu đỏ.

Miccpro · 26/6/18

befaint đã viết:
Gửi file lên xem nào: Cho gì, cần gì và kết quả minh họa. Có hơn 100 bài viết rồi mà...

Cảm ơn anh, em gửi file ạ

Ba Tê · 26/6/18

Miccpro đã viết:
Cảm ơn anh, em gửi file ạ

Tìm thấy thì thoát vòng lặp, True/False phải trả lại ban đầu trước mỗi lần tìm.

PHP:

Public Sub GPE_01()
Dim Rng As Range, Arr(), I As Long, J As Long, N As Long, DK As Boolean
Arr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
Set Rng = Sheets("Run").Range("C7:G13")
    For J = 2 To 5
        For I = 1 To 7
            If Rng(I, J).Value <> "" Then
                DK = False
                Tem = Rng(I, 1).Value & "#" & Rng(I, J).Value
                For N = 1 To UBound(Arr)
                    If Arr(N, 1) & "#" & Arr(N, 2) = Tem Then
                        DK = True: Exit For
                    End If
                Next N
                If DK = False Then Rng(I, J).Value = "Sai"
            End If
        Next I
    Next J
Set Rng = Nothing
End Sub

Hoặc như vầy:

PHP:

Public Sub GPE_02()
Dim sArr(), I As Long, J As Long, Tem As String
With CreateObject("Scripting.Dictionary")
    sArr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
    For I = 1 To UBound(sArr)
        .Item(sArr(I, 1) & "#" & sArr(I, 2)) = ""
    Next I
    sArr = Sheets("Run").Range("C7:G13").Value
    For J = 2 To 5
        For I = 1 To 7
            If sArr(I, J) <> "" Then
                Tem = sArr(I, 1) & "#" & sArr(I, J)
                If Not .Exists(Tem) Then sArr(I, J) = "Sai"
            End If
        Next I
    Next J
    Sheets("Run").Range("C22:G28") = sArr
End With
End Sub

lequan2583 · 26/6/18

Nhờ Bác Ba Tê xem sửa giúp code để tổng hợp dữ liệu với 2 điều kiện ( xin lỗi Bác vì đã chen ngang)

trong bài toán trích lọc danh sách duy nhất và tổng hợp dữ liệu với 2 điều kiện
1. trùng part code cột B sheet PO
2. trùng Delivery date cột K sheet PO
thì tổng hợp dữ liệu số lượng cột L (Qty) từ sheet Po sang sheet linkpo như file đính kèm

nhưng trong code hiện tại chưa đáp ứng được điều kiện thứ 2
vì khi xóa dữ liệu ngày ở sheet linkpo từ ô G9 trở đi thì vẫn ra kết quả bình thường

Sub linkpo()
On Error GoTo 1:
Dim Rng(), Arr(), Dic As Object, t, lCal
Dim c As Long, i As Long, K As Long, D As Long, Tem As String
Application.ScreenUpdating = False
lCal = Application.Calculation: Application.Calculation = xlCalculationManual
t = Timer
Const nCol = 1000
Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("linkpo")
K = .[B15000].End(xlUp).Row:
If K > 2 Then .[A10].Resize(K - 2, nCol).ClearContents
D = .[F9].Value
End With
With Sheets("po"): Rng = .Range(.[B5], .[B15000].End(xlUp)).Resize(, 11).Value: End With
ReDim Arr(1 To UBound(Rng, 1), 1 To nCol)
K = 0
For i = 1 To UBound(Rng, 1)
If Rng(i, 10) <> "" Then
c = Rng(i, 10) - D + 6
Tem = Rng(i, 1)
If Dic.Exists(Tem) Then
Arr(Dic.Item(Rng(i, 1)), c) = Arr(Dic.Item(Rng(i, 1)), c) + Rng(i, 11)
Else
K = K + 1: Dic.Add (Tem), K
Arr(K, 1) = K: Arr(K, 3) = Tem: Arr(K, c) = Rng(i, 11)
Arr(K, 4) = Rng(i, 2)
End If
End If
Next i
Set Dic = Nothing
Sheets("linkpo").[A10].Resize(K, nCol).Value = Arr
With Sheets("linkpo")
Range("B10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[1],'Master list'!R2C2:R50C3,2,3,1)"
Range("B10").Select
Selection.AutoFill Destination:=Range("B10:B48")
Range("E10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[-2],'Master list'!R2C3:R50C5,3,2,1)"
Range("E10").Select
Selection.AutoFill Destination:=Range("E10:E48")
Range("B10").Select

End With

1: Application.ScreenUpdating = True: Application.Calculation = lCal

End Sub

Attachments

Miccpro · 26/6/18

Các anh chị cho em hỏi tại sao bài anh Ba Tê trả lời giúp em lại không thấy được ạ. Khi em phải đăng xuất thì lại thấy, cảm ơn anh Ba Tê (em không thấy bài anh để cảm ơn)

Tìm thấy thì thoát vòng lặp, True/False phải trả lại ban đầu trước mỗi lần tìm.

PHP:
Public Sub GPE_01()
Dim Rng As Range, Arr(), I As Long, J As Long, N As Long, DK As Boolean
Arr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
Set Rng = Sheets("Run").Range("C7:G13")
For J = 2 To 5
For I = 1 To 7
If Rng(I, J).Value <> "" Then
DK = False
Tem = Rng(I, 1).Value & "#" & Rng(I, J).Value
For N = 1 To UBound(Arr)
If Arr(N, 1) & "#" & Arr(N, 2) = Tem Then
DK = True: Exit For
End If
Next N
If DK = False Then Rng(I, J).Value = "Sai"
End If
Next I
Next J
Set Rng = Nothing
End Sub

Hoặc như vầy:

PHP:
Public Sub GPE_02()
Dim sArr(), I As Long, J As Long, Tem As String
With CreateObject("Scripting.Dictionary")
sArr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
For I = 1 To UBound(sArr)
.Item(sArr(I, 1) & "#" & sArr(I, 2)) = ""
Next I
sArr = Sheets("Run").Range("C7:G13").Value
For J = 2 To 5
For I = 1 To 7
If sArr(I, J) <> "" Then
Tem = sArr(I, 1) & "#" & sArr(I, J)
If Not .Exists(Tem) Then sArr(I, J) = "Sai"
End If
Next I
Next J
Sheets("Run").Range("C22:G28") = sArr
End With
End Sub

Sunbinsuzin · 26/6/18

SA_DQ đã viết:
Kiểu này nên có file thì may ra có đáp án cho bạn.

truongvu317 đã viết:
Xin nhận khuyết điểm là em quá ngây thơ khi nhìn ảnh.

Cái hàm bạn muốn viết nó tính toán cái gì vậy mà ghê thế, đưa file lên.

Mục file của em là trích lọc DUY NHẤT theo 6 điều kiện sau đó tính tổng số lượng ạ. Em mới tập tành viết tới 6 điều kiện hàm đã chạy ì ạch rồi nên nhờ mấy bác sửa code lại dùm em với a. cám ơn các bác trước

Code trong file FILE TEXT DO TIM 6 DIEU KIEN + TINH SUM.xls

Function SUMTK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
On Error Resume Next
Dim I As Integer, iCount As Integer, TAM As Variant
iCount = VUNGDK1.Rows.Count
For I = 1 To iCount
If UCase(VUNGDK1.Cells(I, 1)) = UCase(DK1) Then
If UCase(VUNGDK2.Cells(I, 1)) = UCase(DK2) Then
If UCase(VUNGDK3.Cells(I, 1)) = UCase(DK3) Then
If UCase(VUNGDK4.Cells(I, 1)) = UCase(DK4) Then
If UCase(VUNGDK5.Cells(I, 1)) = UCase(DK5) Then
If UCase(VUNGDK6.Cells(I, 1)) = UCase(DK6) Then
TAM = TAM + VUNGKQ.Cells(I, 1)
End If
End If
End If
End If
End If
End If
Next I
SUMTK6DK = TAM
End Function
Function TK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, _
VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
Dim I As Integer, iCount As Integer
iCount = VUNGDK1.Rows.Count
For I = 1 To iCount
If UCase(VUNGDK1.Cells(I, 1)) + UCase(VUNGDK2.Cells(I, 1)) = UCase(DK1) + UCase(DK2) Then
If UCase(VUNGDK3.Cells(I, 1)) = UCase(DK3) Then
If UCase(VUNGDK4.Cells(I, 1)) = UCase(DK4) Then
If UCase(VUNGDK5.Cells(I, 1)) = UCase(DK5) Then
If UCase(VUNGDK6.Cells(I, 1)) = UCase(DK6) Then
TK6DK = VUNGKQ.Cells(I, 1)
Exit For
End If
End If
End If
End If
End If
Next I
End Function

ndu96081631 · 26/6/18

Topic đã quá dài ---> Đóng topic
Anh em có nhu cầu hỏi về code (chung chung) vui lòng mở topic khác

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

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

Huyền thoại GPE

Thành viên mới

Thành viên mới

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

File đính kèm

==(^o^)==

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

==(^o^)==

Thành viên mới

Thành viên mới

==(^o^)==

Thành viên mới

File đính kèm

Thành viên mới

==(^o^)==

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

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

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

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

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

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

Đang đi tìm hòn đá

Thành viên mới

File đính kèm

Thành viên mới

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

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 mới

Thành viên mới

Thành viên mới

File đính kèm

/(hông là gì!

==(^o^)==

Thành viên mới

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 tiêu biểu

File đính kèm

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

==(^o^)==

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

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

Thành viên mới

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

Đang đi tìm hòn đá

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

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

Thành viên mới

File đính kèm

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

Thành viên mới

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

Thành viên mới

Thành viên mới

Thành viên mới

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

File đính kèm

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên mới

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

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

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

Đang đi tìm hòn đá