Code bị lỗi

Liên hệ QC
H

hoituong1020

Thành viên mới
Tham gia
8/12/15
Bài viết
46
Được thích
0
Chào các anh/chị trong diễn đàn!
Tôi có file excel trích xuất dữ liệu ở các sheet vào sheet tổng hợp thì bị báo lỗi code không trích xuất được dữ liệu. Lúc đầu thì trích xuất được nhưng sau ko trích xuất được dữ liệu. Code của tôi như sau:
Sub DSDTTB()
Dim ws As Worksheet
Dim lr As Long, j As Long, r As Long, k As Long, i As Byte
Dim arr As Variant, kq As Variant, DK As Boolean
Dim BD As Long, ED As Long, dktienbo As String
With Sheet4
BD = CLng(.Range("V4").Value)
ED = CLng(.Range("V5").Value)
dktienbo = CByte(UCase(.Range("V6").Value))
.Range("A11:W" & WorksheetFunction.Max(11, .Cells(Rows.Count, "A").End(xlUp).Row)).ClearContents
End With
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = lr + ws.Cells(Rows.Count, "B").End(xlUp).Row
End If
Next ws
ReDim kq(1 To (Sheets.Count - 4) * 10, 1 To Columns("AC").Column)
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
arr = ws.Range("B11:AC" & lr).Value
For j = 1 To UBound(arr, 1)
DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
If DK Then
k = k + 1
kq(k, 1) = ws.Name
kq(k, 2) = arr(j, 1)
kq(k, 3) = arr(j, 2)
For i = 4 To UBound(arr, 2) - 4
kq(k, i) = arr(j, i + 4)
Next i
End If
Next j
Erase arr
End If
Next ws
If k >= 1 Then
Sheet4.Range("a11").Resize(k, Columns("W").Column).Value = kq
Erase kq
End If
Set ws = Nothing
End Sub
Sub DSDTTB()
Dim ws As Worksheet
Dim lr As Long, j As Long, r As Long, k As Long, i As Byte
Dim arr As Variant, kq As Variant, DK As Boolean
Dim BD As Long, ED As Long, dktienbo As String
With Sheet4
BD = CLng(.Range("V4").Value)
ED = CLng(.Range("V5").Value)
dktienbo = CByte(UCase(.Range("V6").Value))
.Range("A11:W" & WorksheetFunction.Max(11, .Cells(Rows.Count, "A").End(xlUp).Row)).ClearContents
End With
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = lr + ws.Cells(Rows.Count, "B").End(xlUp).Row
End If
Next ws
ReDim kq(1 To (Sheets.Count - 4) * 10, 1 To Columns("AC").Column)
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
arr = ws.Range("B11:AC" & lr).Value
For j = 1 To UBound(arr, 1)
DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
If DK Then
k = k + 1
kq(k, 1) = ws.Name
kq(k, 2) = arr(j, 1)
kq(k, 3) = arr(j, 2)
For i = 4 To UBound(arr, 2) - 4
kq(k, i) = arr(j, i + 4)
Next i
End If
Next j
Erase arr
End If
Next ws
If k >= 1 Then
Sheet4.Range("a11").Resize(k, Columns("W").Column).Value = kq
Erase kq
End If
Set ws = Nothing
End Sub

bị báo lỗi ở dòng:
DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
Mong các anh/chị giúp dùm.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Lỗi đúng cái chỗ này còn gì: DK = CLng(arr(j, 1)) >= BD
 
Upvote 0
hoituong1020 đã viết:
Chào các anh/chị trong diễn đàn!
Tôi có file excel trích xuất dữ liệu ở các sheet vào sheet tổng hợp thì bị báo lỗi code không trích xuất được dữ liệu. Lúc đầu thì trích xuất được nhưng sau ko trích xuất được dữ liệu. Code của tôi như sau:
Sub DSDTTB()
Dim ws As Worksheet
Dim lr As Long, j As Long, r As Long, k As Long, i As Byte
Dim arr As Variant, kq As Variant, DK As Boolean
Dim BD As Long, ED As Long, dktienbo As String
With Sheet4
BD = CLng(.Range("V4").Value)
ED = CLng(.Range("V5").Value)
dktienbo = CByte(UCase(.Range("V6").Value))
.Range("A11:W" & WorksheetFunction.Max(11, .Cells(Rows.Count, "A").End(xlUp).Row)).ClearContents
End With
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = lr + ws.Cells(Rows.Count, "B").End(xlUp).Row
End If
Next ws
ReDim kq(1 To (Sheets.Count - 4) * 10, 1 To Columns("AC").Column)
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
arr = ws.Range("B11:AC" & lr).Value
For j = 1 To UBound(arr, 1)
DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
If DK Then
k = k + 1
kq(k, 1) = ws.Name
kq(k, 2) = arr(j, 1)
kq(k, 3) = arr(j, 2)
For i = 4 To UBound(arr, 2) - 4
kq(k, i) = arr(j, i + 4)
Next i
End If
Next j
Erase arr
End If
Next ws
If k >= 1 Then
Sheet4.Range("a11").Resize(k, Columns("W").Column).Value = kq
Erase kq
End If
Set ws = Nothing
End Sub
Sub DSDTTB()
Dim ws As Worksheet
Dim lr As Long, j As Long, r As Long, k As Long, i As Byte
Dim arr As Variant, kq As Variant, DK As Boolean
Dim BD As Long, ED As Long, dktienbo As String
With Sheet4
BD = CLng(.Range("V4").Value)
ED = CLng(.Range("V5").Value)
dktienbo = CByte(UCase(.Range("V6").Value))
.Range("A11:W" & WorksheetFunction.Max(11, .Cells(Rows.Count, "A").End(xlUp).Row)).ClearContents
End With
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = lr + ws.Cells(Rows.Count, "B").End(xlUp).Row
End If
Next ws
ReDim kq(1 To (Sheets.Count - 4) * 10, 1 To Columns("AC").Column)
For Each ws In Sheets
If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
arr = ws.Range("B11:AC" & lr).Value
For j = 1 To UBound(arr, 1)
DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
If DK Then
k = k + 1
kq(k, 1) = ws.Name
kq(k, 2) = arr(j, 1)
kq(k, 3) = arr(j, 2)
For i = 4 To UBound(arr, 2) - 4
kq(k, i) = arr(j, i + 4)
Next i
End If
Next j
Erase arr
End If
Next ws
If k >= 1 Then
Sheet4.Range("a11").Resize(k, Columns("W").Column).Value = kq
Erase kq
End If
Set ws = Nothing
End Sub

bị báo lỗi ở dòng:
DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
Mong các anh/chị giúp dùm.
Nhấp chuột vào đây để mở rộng...
Bạn cần thêm câu điều kiện để không kiểm tra nhưng sheets mà bạn ẩn đi.Vì nó đang báo lỗi khi chuyển dữ liệu thành số.Ở câu Clng(arr(j,1)) thi arr(j,1) nó không phải dạng date mà là string nên nó báo lỗi.Bạn thử thế này xem.
Mã: 
Sub DSDTTB()
    Dim ws As Worksheet
    Dim lr As Long, j As Long, r As Long, k As Long, i As Byte
    Dim arr As Variant, kq As Variant, DK As Boolean
    Dim BD As Long, ED As Long, dktienbo As String
    
    With Sheet4
        BD = CLng(.Range("V4").Value)
        ED = CLng(.Range("V5").Value)
        dktienbo = CByte(UCase(.Range("V6").Value))
        .Range("A11:W" & WorksheetFunction.Max(11, .Cells(Rows.Count, "A").End(xlUp).Row)).ClearContents
    End With

    For Each ws In Sheets
        If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
                    lr = lr + ws.Cells(Rows.Count, "B").End(xlUp).Row
        End If
       Next ws
       ReDim kq(1 To (Sheets.Count - 4) * 10, 1 To Columns("AC").Column)
            
    For Each ws In Sheets
    If ws.Visible = xlSheetVisible Then
         If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
            lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
            arr = ws.Range("B11:AC" & lr).Value
            For j = 1 To UBound(arr, 1)
                DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
                
                If DK Then
                    k = k + 1
                    kq(k, 1) = ws.Name
                    kq(k, 2) = arr(j, 1)
                    kq(k, 3) = arr(j, 2)
                    For i = 4 To UBound(arr, 2) - 4
                        kq(k, i) = arr(j, i + 4)
                    Next i
                End If
            Next j
            Erase arr
        End If
    End If
    Next ws
    
    If k >= 1 Then
        Sheet4.Range("a11").Resize(k, Columns("W").Column).Value = kq
        Erase kq
    End If
    
    Set ws = Nothing
    
End Sub
 
Upvote 0
snow25 đã viết:
Bạn cần thêm câu điều kiện để không kiểm tra nhưng sheets mà bạn ẩn đi.Vì nó đang báo lỗi khi chuyển dữ liệu thành số.Ở câu Clng(arr(j,1)) thi arr(j,1) nó không phải dạng date mà là string nên nó báo lỗi.Bạn thử thế này xem.
Mã: 
Sub DSDTTB()
    Dim ws As Worksheet
    Dim lr As Long, j As Long, r As Long, k As Long, i As Byte
    Dim arr As Variant, kq As Variant, DK As Boolean
    Dim BD As Long, ED As Long, dktienbo As String
   
    With Sheet4
        BD = CLng(.Range("V4").Value)
        ED = CLng(.Range("V5").Value)
        dktienbo = CByte(UCase(.Range("V6").Value))
        .Range("A11:W" & WorksheetFunction.Max(11, .Cells(Rows.Count, "A").End(xlUp).Row)).ClearContents
    End With

    For Each ws In Sheets
        If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
                    lr = lr + ws.Cells(Rows.Count, "B").End(xlUp).Row
        End If
       Next ws
       ReDim kq(1 To (Sheets.Count - 4) * 10, 1 To Columns("AC").Column)
           
    For Each ws In Sheets
    If ws.Visible = xlSheetVisible Then
         If CByte(Right(ws.CodeName, 1)) >= 6 Or CByte(Right(ws.CodeName, 1)) <= 1 Then
            lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
            arr = ws.Range("B11:AC" & lr).Value
            For j = 1 To UBound(arr, 1)
                DK = CLng(arr(j, 1)) >= BD And CLng(arr(j, 1)) <= ED And CByte(arr(j, Columns("Y").Column - 1)) = dktienbo
               
                If DK Then
                    k = k + 1
                    kq(k, 1) = ws.Name
                    kq(k, 2) = arr(j, 1)
                    kq(k, 3) = arr(j, 2)
                    For i = 4 To UBound(arr, 2) - 4
                        kq(k, i) = arr(j, i + 4)
                    Next i
                End If
            Next j
            Erase arr
        End If
    End If
    Next ws
   
    If k >= 1 Then
        Sheet4.Range("a11").Resize(k, Columns("W").Column).Value = kq
        Erase kq
    End If
   
    Set ws = Nothing
   
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn nhiều, với lại bạn cho mình hỏi là ở sheet "DSTB" từ cột T đến cột W sao nó không chạy đúng cột, bạn giúp dùm mình chỉnh lại 4 cột cuối. Cảm ơn bạn nhiều
 
Upvote 0
hoituong1020 đã viết:
Cảm ơn bạn nhiều, với lại bạn cho mình hỏi là ở sheet "DSTB" từ cột T đến cột W sao nó không chạy đúng cột, bạn giúp dùm mình chỉnh lại 4 cột cuối. Cảm ơn bạn nhiều
Nhấp chuột vào đây để mở rộng...
Mình chỉ sửa lỗi thôi không xem code nên không biết nó đúng hay sai bạn à.:D.
 
Upvote 0
Mong các anh/chị giúp dùm mình với là ở sheet "DSTB" từ cột T đến cột W sao nó không chạy đúng cột, và khi mình thay đổi vị trí của sheet “DSTB” thì nó không chạy được.
Cảm ơn các anh/chị nhiều
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

tramcannt
Các bác cho hỏi làm cách nào để thu nhỏ thanh công thức này với ạ. Em cảm ơn.
Trả lời
0
Đọc
5
tramcannt
tramcannt
S
  • Question Question
Điều chỉnh kích thước dòng tự động theo trang in
Trả lời
5
Đọc
103
HUONGHCKT
H
A
Tạo vé Loto bằng Excel
2
Trả lời
20
Đọc
23K
Tuấn tata
Tuấn tata
T
File quản lý thiết bị trong trường học!
Trả lời
3
Đọc
72
SA_DQ
SA_DQ
Nauduong
Cách chuyển định dạng từ PDF sang Image
Trả lời
9
Đọc
224
Châu Bá Thông
Châu Bá Thông
minhduongct
  • Question Question
Viết code VBA thay cho dùng hàm vlookup
Trả lời
6
Đọc
1K
VetMini
V
N
Thử viết code lập trình đa luồng bằng TwinBasic và khả năng ứng dụng vào COM add-in chạy trong Excel
    • Thích
Trả lời
0
Đọc
90
nguyendang95
N
Momominh
Sơ đồ hàng hóa trong Container
Trả lời
1
Đọc
49
tranhungdao12a3
T
Thanh271188
Tìm giá trị xuất hiện bất kì (không phải giá trị đầu, cuối) trong excel
    • Cười
Trả lời
4
Đọc
207
Duy Tùng 9x
Duy Tùng 9x
H
Xin viết dùng mã vba thay thế cho hàm vlookup
    • Thích
12 13 14
Trả lời
264
Đọc
79K
VetMini
V
SA_DQ
  • Question Question
[Bài tập VBA cho người rỗi rảnh] Hãy viết 1 macro tìm ra 3 số nguyên tố liên tiếp
2
Trả lời
35
Đọc
732
VetMini
V
P
Các Bác cho e hỏi làm thế nào để ẩn công thức trên GOOGLE SHEET với ạ?
2
Trả lời
22
Đọc
18K
yeudoi
yeudoi
T
Định dạng cột dữ liệu trong sql
Trả lời
5
Đọc
129
ptm0412
ptm0412
L
  • Question Question
[Hlep] Xóa ảnh theo tên và kích thước
Trả lời
8
Đọc
188
Luong24
L
Xoainon3005
Xin file mẫu kế hoạch sản xuất theo tháng ngành động cơ
Trả lời
0
Đọc
90
Xoainon3005
Xoainon3005
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
14 15 16
Trả lời
308
Đọc
22K
CheezeTube
CheezeTube
HeSanbi
  • Đã giải quyết
LocalizeXL v1.73 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
74
Đọc
10K
vn72259
V
H
Vì sao trong khi cộng và khi sum lại hiển thị sai
Trả lời
15
Đọc
57K
hieung99
hieung99
T
Nhờ hỗ trợ hàm SUMIF không phân biệt được các ký tự "0" trước một số trong chuỗi
Trả lời
3
Đọc
212
tan10ckn
T
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2 3
Trả lời
46
Đọc
14K
tuantran203
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
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom