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

Liên hệ QC

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

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

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,954
Dạ cảm ơn Anh nhiều quá. quá tuyệt anh ơi. thế là ok rồi.
một lần nữa chân thành cảm ơn anh.
có thể cho e xin số điện thoại không ạ
cho em hỏi thêm tí ạ trong code đoạn nào làm cho tự vẽ khung và ubound, lbound là gì vậy A
 
Lần chỉnh sửa cuối:
Upvote 0
Dạ cảm ơn Anh nhiều quá. quá tuyệt anh ơi. thế là ok rồi.
một lần nữa chân thành cảm ơn anh.
có thể cho e xin số điện thoại không ạ
cho em hỏi thêm tí ạ trong code đoạn nào làm cho tự vẽ khung và ubound, lbound là gì vậy A
Tôi không có dùng điện thoại nhé bạn!
 
Upvote 0
Nhờ giúp đỡ. Mình đang cần sửa file bán hàng này lại cho phù hợp với mình. Mình cần bỏ mục "Số Đôi", thêm Vô mục Tên sản phẩm, khi nhập 1 sản phẩm thì phải nhập mục chiết khấu (mục chiết khấu có 2 tùy chọn là nhâp theo % hoặc nhập theo số tiền. Khi in phiếu ra có mục trừ chiết khấu (làm tròn không lấy số lẻ thâp phân), sheet NKxuatthang có cột trừ chiết khấu. em xin cảm ơn ạ.
 

File đính kèm

Upvote 0
Nhờ các bác chuyển hộ em từ hàm trong FILE KetQua qua vba với ạ vì dùng hàm mỗi lần cập nhật hay sửa dữ liệu thì Excel cứ đơ ra chạy rất rất lâu mới cho ra kết quả.

Em xin nói thông tin về 3 FILE của em chút
FILE Gia có Tên ---- PO-----Giá
File PO có Tên --------PO-------Số lượng
File Ketqua có Tên.

Em lấy PO ở FILE PO điều kiện mà max số lượng, lấy giá ở fie giá điều kiện là Tên và PO, khi sảy ra lỗi thì kết quả là " Không tìm thấy dữ liệu".

Trong FILE em giử lên em đã bỏ đi hàm iferror khi để các bác nhìn cho đỡ rối ạ.

Nếu được các bác cải tiến dùm em là khi mở file ketqua thì tự động Copy sheet nằm ở vị trí đầu tiên của file PO và Copy Sheet nằm ở vị trí đầu của file Gia vào trong FILE KetQua và trong FILE KetQua khi em nhập thêm Tên thì cột PO SoLuong và Gia tự động hiện kết quả a.

Khi đóng file hoặc khi mở file thì việc đầu tiên là xoá 2 Sheet Copy đó đi vì em sợ nếu 2 file kia có vấn đề gì đó ko Copy qua được thì khi nhập Tên vào thì kết quả trả về là dữ liệu đã cũ rồi ạ.

Thêm 1 rắc rối nữa là FILE Gia có 2 lớp pass như trong FILE em UP và thường có 1 cái thông báo Link hỏng vậy các bác có thể thêm luôn Password vào code cho em được ko ạ. Nếu Password đúng từ Copy, nếu Password ko đúng thì mở hộp thoại thông báo sai Password or mở cái hộp thoại nhập Password cũng được ạ.

Thêm code kiểm 2 file PO và Gia có tồn tại ko nữa ạ nếu tồn tại thì Copy ko tồn tại thì báo không tìm thấy FILE ạ.
Password file Gia là: 2 số 1 và 1 số ạ
11
1
Thank các bán trước
hix. Em nguyễn cứu code trong diễn dàn cả tháng rồi mà ko tìm thấy code mình cần nên mới mạo muội nhờ mấy bác!!! Nhưng mà tình hình này chắc phải cứu nhâm njawx thôi
 
Upvote 0
Upvote 0
hix. Em nguyễn cứu code trong diễn dàn cả tháng rồi mà ko tìm thấy code mình cần nên mới mạo muội nhờ mấy bác!!! Nhưng mà tình hình này chắc phải cứu nhâm njawx thôi
Để cái thiện tốc độ thì sửa công thức đi, đừng có dùng tham chiếu kiểu A:A, làm vậy sẽ rất chậm do nó phải tính toán, thay bằng A1:A30000 chẳng hạn.
 
Upvote 0
Bạn đưa cái file mẫu lên đi,
File của em đây bác nhưng mà là file chạy bằng hàm ko phải là fife chạy bằng code.
File chạy code em copy trên diễn đàn ghép lại rồi học ghi macro để chỉnh sửa tiếp..... nhưng mà tình hình là cứ bị công việc dè nên ko suy nghĩ được gì
Bài đã được tự động gộp:

Để cái thiện tốc độ thì sửa công thức đi, đừng có dùng tham chiếu kiểu A:A, làm vậy sẽ rất chậm do nó phải tính toán, thay bằng A1:A30000 chẳng hạn.
File gốc của em thì chỉ có 1 đòng công thức dạng text thôi. Mỗi lần em sử dụng hàm em chỉnh số dòng đúng bằng số dòng của FILE giá rồi mới kéo công thức xuống nhưng giờ FILE giá cũng hơn 60000 dòng rồi nên chạy rất chậm ạ
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
File của em đây bác nhưng mà là file chạy bằng hàm ko phải là fife chạy bằng code.
File chạy code em copy trên diễn đàn ghép lại rồi học ghi macro để chỉnh sửa tiếp..... nhưng mà tình hình là cứ bị công việc dè nên ko suy nghĩ được gì
Bài đã được tự động gộp:


File gốc của em thì chỉ có 1 đòng công thức dạng text thôi. Mỗi lần em sử dụng hàm em chỉnh số dòng đúng bằng số dòng của FILE giá rồi mới kéo công thức xuống nhưng giờ FILE giá cũng hơn 60000 dòng rồi nên chạy rất chậm ạ
Nhờ giúp đỡ mà còn đặt mật khẩu file thì có ma mới giúp cho bạn.
 
Upvote 0
Nhờ giúp đỡ mà còn đặt mật khẩu file thì có ma mới giúp cho bạn.
Dạ tại em đặt cho giống với cái FILE lấy giá trong Cty ạ. Ở bài trước em nói Password mở file là 11 và Password ko cho sửa nội dung là 1.
Bài đã được tự động gộp:

Nhờ giúp đỡ mà còn đặt mật khẩu file thì có ma mới giúp cho bạn.
Em đọc khá nhiều bài trong diễn đàn nên em nói hết ý của em ở bài #1797 và nhờ các bác giúp đỡ chứ sợ công sức các bác bỏ ra giúp em mà này thêm cái này mai sửa cái kia em cũng ngại ạ
 
Lần chỉnh sửa cuối:
Upvote 0
kính gửi giaiphap
nhờ A giúp hết dùm e làm 1 việc nữa cho hoàn thiện nha. phần em tô đỏ
em cảm ơn nhiều
Bạn xem kỷ chưa? đặc biệt là ô L32, mình thấy nó sai sai sao ấy. Bạn khẳng định lại lần nửa để giúp xong lại báo công thức chưa chính xác nửa thì làm lại lần nửa mất công.
 
Upvote 0
Bạn xem kỷ chưa? đặc biệt là ô L32, mình thấy nó sai sai sao ấy. Bạn khẳng định lại lần nửa để giúp xong lại báo công thức chưa chính xác nửa thì làm lại lần nửa mất công.
Dạ ô L32 theo file mẫu là hàm sum tổng công cho các ô của từng loại trợ giá. nếu ngày nào đó thanh toán nhiều thì lọc thì là ô
L khác ạ.
em có đoạn code đọc số ra chữ và em muốn đưa code đó vào để đọc ô tông cộng tiền chi thanh toán cho ngày hôm đó
e cảm ơn rất nhiều
 

File đính kèm

Upvote 0
Dạ ô L32 theo file mẫu là hàm sum tổng công cho các ô của từng loại trợ giá. nếu ngày nào đó thanh toán nhiều thì lọc thì là ô
L khác ạ.
em có đoạn code đọc số ra chữ và em muốn đưa code đó vào để đọc ô tông cộng tiền chi thanh toán cho ngày hôm đó
e cảm ơn rất nhiều
Code cho file ở #1815.
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, 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
 
Upvote 0
Em mới tập tành reco macro nhưng khi save và chạy file thì lỗi như trong hình. ko biết là phải sửa thế nào. nhờ mấy bác giúp em sửa với ạ
Private Sub Workbook_Open()
Sheets("PO").Select
Cells.Select
Selection.ClearContents
Sheets("GIA").Select
Cells.Select
Selection.ClearContents
Workbooks.Open ("C:\Users\pmc_y\Documents\THAO\TEXT\PO.xlsx")
Cells.Select
Selection.Copy
Windows("File ket qua.xls").Activate
Sheets("PO").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("PO.xlsx").Activate
ActiveWindow.Close
Workbooks.Open ("C:\Users\pmc_y\Documents\THAO\TEXT\GIA.xlsx")
Cells.Select
Selection.Copy
Windows("File ket qua.xls").Activate
Sheets("GIA").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("GIA.xlsx").Activate
ActiveWindow.Close
Sheets("Sheet1").Select
Range("A1").Select
End Sub

Loi code.jpgThong bao khi save.jpg
 

File đính kèm

Upvote 0
Em mới tập tành reco macro nhưng khi save và chạy file thì lỗi như trong hình. ko biết là phải sửa thế nào. nhờ mấy bác giúp em sửa với ạ
Private Sub Workbook_Open()
Sheets("PO").Select
Cells.Select
Selection.ClearContents
Sheets("GIA").Select
Cells.Select
Selection.ClearContents
Workbooks.Open ("C:\Users\pmc_y\Documents\THAO\TEXT\PO.xlsx")
Cells.Select
Selection.Copy
Windows("File ket qua.xls").Activate
Sheets("PO").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("PO.xlsx").Activate
ActiveWindow.Close
Workbooks.Open ("C:\Users\pmc_y\Documents\THAO\TEXT\GIA.xlsx")
Cells.Select
Selection.Copy
Windows("File ket qua.xls").Activate
Sheets("GIA").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("GIA.xlsx").Activate
ActiveWindow.Close
Sheets("Sheet1").Select
Range("A1").Select
End Sub

View attachment 197193View attachment 197194
Đư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.
 
Upvote 0
Em mới tập tành reco macro nhưng khi save và chạy file thì lỗi như trong hình. ko biết là phải sửa thế nào. nhờ mấy bác giúp em sửa với ạ
Private Sub Workbook_Open()
Sheets("PO").Select
Cells.Select
Selection.ClearContents
Sheets("GIA").Select
Cells.Select
Selection.ClearContents
Workbooks.Open ("C:\Users\pmc_y\Documents\THAO\TEXT\PO.xlsx")
Cells.Select
Selection.Copy
Windows("File ket qua.xls").Activate
Sheets("PO").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("PO.xlsx").Activate
ActiveWindow.Close
Workbooks.Open ("C:\Users\pmc_y\Documents\THAO\TEXT\GIA.xlsx")
Cells.Select
Selection.Copy
Windows("File ket qua.xls").Activate
Sheets("GIA").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("GIA.xlsx").Activate
ActiveWindow.Close
Sheets("Sheet1").Select
Range("A1").Select
End Sub

View attachment 197193View attachment 197194
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
 
Upvote 0
Code cho file ở #1815.
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, 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
Dạ gửi A giaiphap
Nhờ A đưa code vào file dùm sao e đưa vào bảng tính đứng im ko lọc gì cả.
cảm ơn Anh
Bài đã được tự động gộp:

Dạ gửi A giaiphap
Nhờ A đưa code vào file dùm sao e đưa vào bảng tính đứng im ko lọc gì cả.
cảm ơn Anh
Dạ cảm ơn A giaiphap
code ok rồi A. em viết thêm định dạng tiền tệ bị lỗi.
chân thành cảm ơn sự giúp đở của Anh. Mong được thêm sự hỗ trợ hướng dẫn của Anh trong thời gian tới.
Cảm ơn A nhiều
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

Back
Top Bottom