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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Status
Không mở trả lời sau này.
ndu96081631

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,958
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Xin chỉnh giúp đoạn code bên dưới vì khi đưa câu Option Explicit thì nó bị lỗi.
Cảm ơn các anh chị nhiều.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each Cll In Intersect(Target.EntireRow, [B:B])
If Cll.Row > 7 Then
If Cll.Value = "" Then
Range("A8:A1000").ClearContents
Else
If Range("A" & Cll.Row).Formula = "" Then Range("A" & Cll.Row).FormulaR1C1 = "=IF(RC[1]<>"""",MAX(R7C1:R[-1]C)+1,"""")"
If Range("L" & Cll.Row).Formula = "" Then Range("L" & Cll.Row).FormulaR1C1 = "=IF(RC[-10]="""","""",IF(RC[-5]=""x"",""x"",""/""))"
If Range("M" & Cll.Row).Formula = "" Then Range("M" & Cll.Row).FormulaR1C1 = "=IF(RC[-11]="""","""",IF(RC[-2]=R1C11,""Cdi"",IF(RC[-2]=R2C11,""Cde"",""/"")))"
If Range("N" & Cll.Row).Formula = "" Then Range("N" & Cll.Row).FormulaR1C1 = "=RIGHT(RC[-6],2)"
End If
End If
Next
Application.EnableEvents = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
Chào cả nhà. Mình mới học VBA nên gà mờ quá. Đang code đến chỗ này thì nó báo lỗi Application-Defined or Object-defined error 1004 chỗ Do While mà mình k hiểu mình sai ở đâu. Mong các cao nhân chỉ giáo
Mã: 
Sub Button1_Click()

Dim id1, id2, id3, id4, id5, id6 As Variant

Dim i, n As Integer

Worksheets("ACC").Activate

id1 = Sheets("ACC").Range("E5").Value
id2 = Sheets("ACC").Range("G5").Value
id3 = Sheets("ACC").Range("I5").Value
id4 = Sheets("ACC").Range("K5").Value
id5 = Sheets("ACC").Range("M5").Value
id6 = Sheets("ACC").Range("O5").Value

Worksheets("TOEICScore").Activate



Do While id1 = Sheets("TOEICScore").Range("A", i).Value Or Sheets("TOEICScore").Range("A", i).Value = Null
      If id1 = Sheets("TOEICScore").Range("A", i).Value Then
         Sheets("ACC").Range("F5").Value = Sheets("TOEICScore").Range("B", i).Value
         Sheets("ACC").Range("E21").Value = Sheets("TOEICScore").Range("F", i).Value
         Sheets("ACC").Range("F21").Value = Sheets("TOEICScore").Range("E", i).Value
      End If
      i = i + 1

Loop

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
huongmuine đã viết:
Xin chỉnh giúp đoạn code bên dưới vì khi đưa câu Option Explicit thì nó bị lỗi.
Cảm ơn các anh chị nhiều.
Nhấp chuột vào đây để mở rộng...
Mã: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
For Each Cll In Intersect(Target.EntireRow, [B:B])
  If Cll.Row > 7 Then
    If Cll.Value = "" Then
      Range("A8:A1000").ClearContents
    Else
      If Range("A" & Cll.Row).Formula = "" Then Range("A" & Cll.Row).FormulaR1C1 = "=IF(RC[1]<>"""",MAX(R7C1:R[-1]C)+1,"""")"
      If Range("L" & Cll.Row).Formula = "" Then Range("L" & Cll.Row).FormulaR1C1 = "=IF(RC[-10]="""","""",IF(RC[-5]=""x"",""x"",""/""))"
      If Range("M" & Cll.Row).Formula = "" Then Range("M" & Cll.Row).FormulaR1C1 = "=IF(RC[-11]="""","""",IF(RC[-2]=R1C11,""Cdi"",IF(RC[-2]=R2C11,""Cde"",""/"")))"
      If Range("N" & Cll.Row).Formula = "" Then Range("N" & Cll.Row).FormulaR1C1 = "=RIGHT(RC[-6],2)"
    End If
  End If
Next
End Sub
 
Upvote 0
HieuCD đã viết:
Mã: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
For Each Cll In Intersect(Target.EntireRow, [B:B])
  If Cll.Row > 7 Then
    If Cll.Value = "" Then
      Range("A8:A1000").ClearContents
    Else
      If Range("A" & Cll.Row).Formula = "" Then Range("A" & Cll.Row).FormulaR1C1 = "=IF(RC[1]<>"""",MAX(R7C1:R[-1]C)+1,"""")"
      If Range("L" & Cll.Row).Formula = "" Then Range("L" & Cll.Row).FormulaR1C1 = "=IF(RC[-10]="""","""",IF(RC[-5]=""x"",""x"",""/""))"
      If Range("M" & Cll.Row).Formula = "" Then Range("M" & Cll.Row).FormulaR1C1 = "=IF(RC[-11]="""","""",IF(RC[-2]=R1C11,""Cdi"",IF(RC[-2]=R2C11,""Cde"",""/"")))"
      If Range("N" & Cll.Row).Formula = "" Then Range("N" & Cll.Row).FormulaR1C1 = "=RIGHT(RC[-6],2)"
    End If
  End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn HieuCD đã nhiệt tình giúp đỡ.
Chúc Bạn cùng gia đình nhiều niềm vui ngày cuối tuần
 

File đính kèm

Upvote 0
Híc. Ko ai giúp mình à. @@
 
Upvote 0
HieuCD đã viết:
Mã: 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cll As Range
For Each Cll In Intersect(Target.EntireRow, [B:B])
  If Cll.Row > 7 Then
    If Cll.Value = "" Then
      Range("A8:A1000").ClearContents
    Else
      If Range("A" & Cll.Row).Formula = "" Then Range("A" & Cll.Row).FormulaR1C1 = "=IF(RC[1]<>"""",MAX(R7C1:R[-1]C)+1,"""")"
      If Range("L" & Cll.Row).Formula = "" Then Range("L" & Cll.Row).FormulaR1C1 = "=IF(RC[-10]="""","""",IF(RC[-5]=""x"",""x"",""/""))"
      If Range("M" & Cll.Row).Formula = "" Then Range("M" & Cll.Row).FormulaR1C1 = "=IF(RC[-11]="""","""",IF(RC[-2]=R1C11,""Cdi"",IF(RC[-2]=R2C11,""Cde"",""/"")))"
      If Range("N" & Cll.Row).Formula = "" Then Range("N" & Cll.Row).FormulaR1C1 = "=RIGHT(RC[-6],2)"
    End If
  End If
Next
End Sub
Nhấp chuột vào đây để mở rộng...
Với đoạn code trên khi thực hiện với dữ liệu khoảng 3000 dòng. code chạy rất lâu.
Xin nhờ các anh chị có thể chỉnh giúp code trên để chạy được nhanh hơn.
Cảm ơn các anh chị nhiều.
 

File đính kèm

Upvote 0
huongmuine đã viết:
Với đoạn code trên khi thực hiện với dữ liệu khoảng 3000 dòng. code chạy rất lâu.
Xin nhờ các anh chị có thể chỉnh giúp code trên để chạy được nhanh hơn.
Cảm ơn các anh chị nhiều.
Nhấp chuột vào đây để mở rộng...
Đã dùng VBA mà nạp công thức cho từng dòng là "kỳ cục". Công thức càng IF() nhiều lại càng nặng.
Ráng chịu đi, hoặc xử lý tất cả bằng VBA 1 lần.
 
Upvote 0
Ba Tê đã viết:
Đã dùng VBA mà nạp công thức cho từng dòng là "kỳ cục". Công thức càng IF() nhiều lại càng nặng.
Ráng chịu đi, hoặc xử lý tất cả bằng VBA 1 lần.
Nhấp chuột vào đây để mở rộng...
Cảm ơn Thầy.
Nhờ Thầy có thể viết giúp đoạn code với ạ. ( Code sẽ xử lý trên các cột tô màu vàng )
Xin cảm ơn Thầy nhiều.
 

File đính kèm

Upvote 0
huongmuine đã viết:
Cảm ơn Thầy.
Nhờ Thầy có thể viết giúp đoạn code với ạ. ( Code sẽ xử lý trên các cột tô màu vàng )
Xin cảm ơn Thầy nhiều.
Nhấp chuột vào đây để mở rộng...
Cột B không biết! Cột V (Nam) là thừa (Tốn công thức) trong khi cột U ghi "x" là Nữ, để trống đã biết là Nam.
Tôi có chèn thêm 1 dòng 2, dữ liệu từ dòng 3.
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, R As Long, Txt As String
Txt = "'11-14"
sArr = Range("M3", Range("M3").End(xlDown)).Resize(, 35).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 24) <> Empty Then
        If sArr(I, 24) = "HTCHTH" Then
            dArr(I, 1) = "HT" & sArr(I, 25)
        ElseIf sArr(I, 27) <> Empty Or sArr(I, 28) <> Empty Then
            dArr(I, 1) = "CDi-BHo"
        Else
            dArr(I, 1) = Left(sArr(I, 24), 1)
        End If
    End If
    dArr(I, 2) = Txt             '<--------------Cột B?'
    dArr(I, 3) = IIf(sArr(I, 31) <> Empty, sArr(I, 31), "/")
Next I
Range("A3").Resize(R, 3) = dArr
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Cột B không biết!
PHP: 
Public Sub GPE()
Dim sArr(), dArr(), I As Long, R As Long, Txt As String
Txt = "'11-14"
sArr = Range("M3", Range("M3").End(xlDown)).Resize(, 35).Value
R = UBound(sArr): ReDim dArr(1 To R, 1 To 3)
For I = 1 To R
    If sArr(I, 24) <> Empty Then
        If sArr(I, 24) = "HTCHTH" Then
            dArr(I, 1) = "HT" & sArr(I, 25)
        ElseIf sArr(I, 27) <> Empty Or sArr(I, 28) <> Empty Then
            dArr(I, 1) = "CDi-BHo"
        Else
            dArr(I, 1) = Left(sArr(I, 24), 1)
        End If
    End If
    dArr(I, 2) = Txt             '<--------------Cột B?'
    dArr(I, 3) = IIf(sArr(I, 31) <> Empty, sArr(I, 31), "/")
Next I
Range("A3").Resize(R, 3) = dArr
End Sub
Nhấp chuột vào đây để mở rộng...
Do vội quá nên nhầm mong thầy thông cảm.
Cột B dùng để tính độ tuổi 11-14 tuổi còn đang học.
Cách tính: lấy năm hiện tại - năm (cột S ). Nếu kết quả bằng hoặc lớn hơn 11 cùng với điều kiện ký tự đầu tiên bên trái cột AJ nhỏ hơn hoặc bằng 5 sẽ ghi ở cột B là 11-14
Cảm ơn thầy nhiều ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Thử xem file này coi có đúng ý bạn không.
Nhấp chuột vào đây để mở rộng...
Dạ đúng rồi ạ, e cảm ơn bác nhiều, nhưng e xin phép được nhờ thêm tí nữa ạ!
Hiện giờ dữ liệu ở M6 chỉ có thể được nhập khi có đủ điều kiện ở K6 là "CHUYỂN ĐƠN"
E muốn nó copy và lặp lại ở tất cả các dòng khi Em sử dụng nút thêm dòng để chèn thêm dòng trong bản tính, để tất cả các dòng chèn thêm đều đáp ứng được yêu cầu cầu tương ứng cho cột M khi có dữ liệu "CHUYỂN ĐƠN" ở cột K được ko ạ?
 

File đính kèm

Upvote 0
Cho em hỏi, hiện tại em có 2 sheet, sheet1 là BQ_Mau và sheet2 là BQ_KMau em lấy được dữ liệu vào một sheet thứ 3 rồi, nhưng trong 2 sheet cần lấy dữ liệu có dữ liệu trùng nhau. Em có viết một đoạn code để lọc dữ liệu mà khi chạy thì tất cả tên ở sheet2 đều giống nhau nhưng vẫn chưa lọc được. Mọi người xem và gợi ý giúp em cách sửa code với ạ. Em cảm ơn.
Đây là đoạn code lấy dữ liệu ở sheet2.
PHP: 
Dim shBQMau As Worksheet
    Dim shBQKMau As Worksheet
    Dim j As Long
    Dim i As Long
    Dim LastRowBQMau As Long
    Dim LastRowBQKMau As Long
  
    wsKCSKo.Select
    Cells(csHangTieuDe, csCotMaVatTu).End(xlDown).Select
    intSoLuongHang = ActiveCell.Row - csHangTieuDe
    
    Set shBQMau = ActiveWorkbook.Worksheets("BQ_Mau")
    Set shBQKMau = ActiveWorkbook.Worksheets("BQ_KMau")
    LastRowBQMau = shBQMau.Cells(Rows.count, "B").End(xlUp).Row
    LastRowBQKMau = shBQKMau.Cells(Rows.count, "B").End(xlUp).Row
    

    For H = 0 To intSoLuongHang - 1

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

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

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

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

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

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

            End If
          
NextH8:
    Next H
 
Lần chỉnh sửa cuối:
Upvote 0
NHờ các anh chị sửa giúp đoạn code trong file.
Khi nhập 1 vào ô K1 sheet AB thì code chạy nhưng nhập 2 code báo lỗi.
Xin cảm ơn
 

File đính kèm

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

File đính kèm

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

File đính kèm

Upvote 0
concuarangme đã viết:
Nhờ các anh chị xem giúp edit code để tìm được trong các sub-folder nhé. File này của anh QuangHai mình tìm được nhưng mình không search được trong các sub-folder. Cảm ơn anh chị
Nhấp chuột vào đây để mở rộng...
Có sẵn rồi mà sửa gì nữa.
Sửa
PHP: 
   Sarr = GetAllFile(path, 0)
thành
PHP: 
   Sarr = GetAllFile(path, True)
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

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

vnxgiokinhtoi
Nhờ giúp đỡ công thức lưu dữ liệu và mở lại dữ liệu cũ đã save (1 người xem)
Trả lời
6
Đọc
175
DeTong
D
A
  • Question Question
Addin lúc hiện lúc không
Trả lời
1
Đọc
52
anhdepjai
A
L
Xin giúp đỡ đổi màu chữ trong mathtype powerpoint sang màu đen
Trả lời
1
Đọc
89
yaaasoo01
Y
T
  • Question Question
Ẩn hiện các sheet khi click vào HyperLink
Trả lời
6
Đọc
270
Gà Công Nghệ
Gà Công Nghệ
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
328
Đọc
25K
lekhoi1492
L
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
17
Đọc
3K
chienthang2682
C
C
Tải kết quả xổ số 3 miền về excel
    • Thích
3 4 5
Trả lời
98
Đọc
13K
HNam_Phan
H
S
Xuất các bảng công phụ từ bảng công chính trong gg sheet
Trả lời
0
Đọc
51
sirhungvla
S
T
Nhờ ACE chỉ giáo công thức Gộp nhiều dữ liệu vào một ô trong excel
Trả lời
11
Đọc
315
Hoàng Tuấn 868
H
PhanTuHuong
Nên chọn điện thoại nào? (7 người xem)
2
Trả lời
21
Đọc
1K
minhminh27
minhminh27
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711) (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
264
Đọc
28K
lilknighthood
L
PhanTuHuong
Hà Nội hẹn hò gặp gỡ đầu năm 2025 thôi :)
    • Thích
    • Yêu thích
Trả lời
9
Đọc
439
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Manhhung90
Tạo nút bấm để xoá nhanh trang trong file word.
Trả lời
3
Đọc
135
PhanTuHuong
PhanTuHuong
H
Hàm Evaluate bị lỗi khi mở lại
2
Trả lời
23
Đọc
347
ptm0412
ptm0412
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Buồn
    • Cười
Trả lời
5
Đọc
262
SA_DQ
SA_DQ
Nguyễn Duy Tuân
Lập trình VBA với Google Drive, OneDrive, DropBox cho Upload-Download-Copy-Move...
    • Cảm ơn
    • Thích
Trả lời
4
Đọc
356
quyenpv
quyenpv
hungmanh.th1
Lỗi không trả về Giá trị 0 trong excel
    • Cười
Trả lời
5
Đọc
112
hungmanh.th1
hungmanh.th1
HeSanbi
  • Question Question
VBA nâng cao: Nhúng tập tin vào trang tính hoặc trích xuất chúng nhanh chóng
    • Thích
    • Cảm ơn
Trả lời
0
Đọc
174
HeSanbi
HeSanbi
nguyễn tiến tú
file CALCULATING rất chậm em nhờ các anh chị xem giúp em ạ
Trả lời
7
Đọc
405
tranhungdao12a3
T
T
  • Question Question
Xin thầy/cô và anh chị giúp đỡ cách điền thông tin ca kíp trực trong bảng Excel bằng VBA
Trả lời
2
Đọc
178
tiennd67
T
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom