Chuyên đề giải đáp những thắc mắc về code VBA

dinhdam90

Thành viên mới
Tham gia ngày
7 Tháng mười hai 2012
Bài viết
4
Được thích
0
Điểm
363
Các bác, các anh chị và các bạn giúp đỡ em về bài này với ạ.
Em có 1 bảng như trong file đính kèm.
Yêu cầu đặt ra như sau: Nhập vào số lượng nhập và số lượng xuất sau đó tính số lượng còn lại.
Nếu số lượng còn lại = 0 thì tô vàng vùng chứa số liệu trong dòng đó còn nếu nhỏ hơn 0 thì chỉ tô màu ô ở cột 5 dòng đó.
Và nếu số lượng xuất bằng rỗng thì để trắng cả dòng đó.
Ví dụ: C2 = 100, nếu D2 = 100 thì tô màu vàng vùng A2:E2, nếu D2 <100 thì tô màu đỏ ô E2 và D2="" thì để trắng vùng A2:E2
Em có viết code VBA như sau nhưng bị lỗi mọi người kiểm tra giúp em với ạ.
Mã:
Dim i As Integer
Dim Vung As Range
Sheets("sheet1").Select
Range("C2").Select
For i = 2 To 11
    If Cells(i, 3) <> Empty Then
        Cells(i, 5).Value = Cells(i, 3).Value - Cells(i, 4).Value
        If Cells(i, 5) = 0 Then
            Set Vung = Range(Cells(i, 1), Cells(i, 5))
            Range("Vung").Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            Else
            Cells(i, 5).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
         End If
      Else
      Cells(i, 5).Value = Empty
       End If
Next i
 

Hoang2013

Thành viên gắn bó
Tham gia ngày
15 Tháng tám 2013
Bài viết
1,625
Được thích
1,598
Điểm
560
Tuổi
6
Tiếc là không mở được file của bạn; Nó báo lỗi định dạng file sao đó.
 

bigbabol89

Thành viên hoạt động
Tham gia ngày
15 Tháng mười 2012
Bài viết
182
Được thích
15
Điểm
370
Em có 1 file này mà khi em chạy VBA thì dữ liệu ở cột Subtype ( màu xanh ) nó mất luôn. Các anh sửa hộ em vẫn giữ được dữ liệu ở các ô xen kẽ như ví dụ được không. Em cám ơn.
 

File đính kèm

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu
Tham gia ngày
10 Tháng ba 2018
Bài viết
675
Được thích
1,424
Điểm
360
Nơi ở
Cái Bang
Em có 1 file này mà khi em chạy VBA thì dữ liệu ở cột Subtype ( màu xanh ) nó mất luôn. Các anh sửa hộ em vẫn giữ được dữ liệu ở các ô xen kẽ như ví dụ được không. Em cám ơn.
Trong Code của bạn không có dArr(K, 4) nên nó vậy
 

bigbabol89

Thành viên hoạt động
Tham gia ngày
15 Tháng mười 2012
Bài viết
182
Được thích
15
Điểm
370
Trong Code của bạn không có dArr(K, 4) nên nó vậy
Anh ơi, em biết ít về VBA lắm, sửa như nào anh sửa hộ em được không ạ ?
Mã:
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, C As Long, R As Long
With Sheets("Roster")
    C = .Range("F2") - .Range("C2") + 6
    sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R * C, 1 To 5)
End With
For I = 5 To R Step 5
    If sArr(I, 1) <> Empty Then
        For J = 6 To C
        K = K + 1
            dArr(K, 1) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(1, J)
            dArr(K, 5) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("IT2003")
    Range("A2").Resize(100000, 5).ClearContents
    If K Then .Range("A2").Resize(K, 5) = dArr
End With
End Sub
 

vanthinh3101

Thành viên tích cực
Tham gia ngày
24 Tháng một 2015
Bài viết
864
Được thích
961
Điểm
360
Tuổi
31
Nơi ở
Hà Nội
Anh ơi, em biết ít về VBA lắm, sửa như nào anh sửa hộ em được không ạ ?
Mã:
Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, C As Long, R As Long
With Sheets("Roster")
    C = .Range("F2") - .Range("C2") + 6
    sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
    R = UBound(sArr, 1)
    ReDim dArr(1 To R * C, 1 To 5)
End With
For I = 5 To R Step 5
    If sArr(I, 1) <> Empty Then
        For J = 6 To C
        K = K + 1
            dArr(K, 1) = K
            dArr(K, 1) = sArr(I, 1)
            dArr(K, 2) = sArr(1, J)
            dArr(K, 3) = sArr(1, J)
            dArr(K, 5) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("IT2003")
    Range("A2").Resize(100000, 5).ClearContents
    If K Then .Range("A2").Resize(K, 5) = dArr
End With
End Sub
Bạn không khai báo dArr(k,4) thì hệ thống tự hiểu cột số 4 (Sub type) là trống.
Nếu muốn người khác sửa cho, bạn phải cho biết dữ liệu bạn muốn có là gì chứ?
 

bigbabol89

Thành viên hoạt động
Tham gia ngày
15 Tháng mười 2012
Bài viết
182
Được thích
15
Điểm
370
Bạn không khai báo dArr(k,4) thì hệ thống tự hiểu cột số 4 (Sub type) là trống.
Nếu muốn người khác sửa cho, bạn phải cho biết dữ liệu bạn muốn có là gì chứ?
Em chỉ muốn ô đó là ô trống, em tự điền. Nhưng khi em chạy code thì dữ liệu em đã điền bị xóa luôn. Ý là cột 1,2,3 là fill dữ liệu từ code, bỏ cột 4 ( tự điền ), fill cột 5 fill dữ liệu từ code
 

vanthinh3101

Thành viên tích cực
Tham gia ngày
24 Tháng một 2015
Bài viết
864
Được thích
961
Điểm
360
Tuổi
31
Nơi ở
Hà Nội
Em chỉ muốn ô đó là ô trống, em tự điền. Nhưng khi em chạy code thì dữ liệu em đã điền bị xóa luôn. Ý là cột 1,2,3 là fill dữ liệu từ code, bỏ cột 4 ( tự điền ), fill cột 5 fill dữ liệu từ code
Bạn xem đúng ý không.
Mã:
Public Sub GPE()
    Dim sArr(), dArr1(), dArr2(), I As Long, J As Long, K As Long, C As Long, R As Long
    With Sheets("Roster")
        C = .Range("F2") - .Range("C2") + 6
        sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
        R = UBound(sArr, 1)
        ReDim dArr1(1 To R * C, 1 To 3): ReDim dArr2(1 To R * C, 1 To 1)
    End With
    For I = 5 To R Step 5
        If sArr(I, 1) <> Empty Then
            For J = 6 To C
                K = K + 1
                dArr1(K, 1) = sArr(I, 1)
                dArr1(K, 2) = sArr(1, J)
                dArr1(K, 3) = sArr(1, J)
                dArr2(K, 1) = sArr(I, J)
            Next J
        End If
    Next I
    With Sheets("IT2003")
        Range("A2").Resize(100000, 3).ClearContents
        Range("E2").Resize(100000).ClearContents
        If K Then .Range("A2").Resize(K, 3) = dArr1: .Range("E2").Resize(K, 1) = dArr2
    End With
End Sub
 

bigbabol89

Thành viên hoạt động
Tham gia ngày
15 Tháng mười 2012
Bài viết
182
Được thích
15
Điểm
370
Bạn xem đúng ý không.
Mã:
Public Sub GPE()
    Dim sArr(), dArr1(), dArr2(), I As Long, J As Long, K As Long, C As Long, R As Long
    With Sheets("Roster")
        C = .Range("F2") - .Range("C2") + 6
        sArr = .Range("B5", .Range("B50000").End(xlUp)).Resize(, C).Value
        R = UBound(sArr, 1)
        ReDim dArr1(1 To R * C, 1 To 3): ReDim dArr2(1 To R * C, 1 To 1)
    End With
    For I = 5 To R Step 5
        If sArr(I, 1) <> Empty Then
            For J = 6 To C
                K = K + 1
                dArr1(K, 1) = sArr(I, 1)
                dArr1(K, 2) = sArr(1, J)
                dArr1(K, 3) = sArr(1, J)
                dArr2(K, 1) = sArr(I, J)
            Next J
        End If
    Next I
    With Sheets("IT2003")
        Range("A2").Resize(100000, 3).ClearContents
        Range("E2").Resize(100000).ClearContents
        If K Then .Range("A2").Resize(K, 3) = dArr1: .Range("E2").Resize(K, 1) = dArr2
    End With
End Sub
Thành công mỹ mãn. Em cám ơn anh rất nhiều
 

Bui Van hieu

Thành viên mới
Tham gia ngày
26 Tháng ba 2018
Bài viết
23
Được thích
0
Điểm
163
Tuổi
31
Hi cả nhà ạ
Mình có viết đoạn code về tìm kiếm trong Combobox như sau:

Dim i As Long
For i = 1 To Application.WorksheetFunction.CountA(Main.Range("F:F"))
If LCase(Left(Main.Cells(i, 1), 1)) = Me.ComboBox1 And Me.ComboBox1 <> "" Then
Me.ComboBox1.AddItem Main.Cells(i, 1)
End If
Next i
Me.ComboBox1.DropDown
With Me
.txtdi.Value = .ComboBox1.List(.ComboBox1.ListIndex, 1)
End With
End Sub

nhưng khi bấm seach thì không hiện ra như mong muốn, chỉ viết tìm kiếm được có một chữ đến 2 chữ cái chứ không viết nhiều được ạ, và viết xong không bấm nút xoá được.
Trong Combobox mình để có 2 cột
Mong cả nhà giúp đỡ ạ
 

cuong.vp.nuce

Thành viên mới
Tham gia ngày
21 Tháng sáu 2016
Bài viết
10
Được thích
0
Điểm
163
Tuổi
29
Cho mình hỏi code:
Mã:
Range("$C$3:$C$1734").AutoFilter Field:=1, Criteria1:="*" & Range("C1").Value & "*", Operator:=xlFilterValues
Nghĩ là gì vậy
 

FPT_online

Thành viên hoạt động
Tham gia ngày
27 Tháng mười 2013
Bài viết
132
Được thích
16
Điểm
370
Tuổi
37
Cho em hỏi đoạn code em viết này sao nó chậm thế, có cách nào cho nhanh hơn không ạ
 

File đính kèm

FPT_online

Thành viên hoạt động
Tham gia ngày
27 Tháng mười 2013
Bài viết
132
Được thích
16
Điểm
370
Tuổi
37
Cho em hỏi nếu viết dưới dạng Application.WorsheetFunction để có thể dùng với nhiều dạng hàm khác thì không được ạ?
 

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu
Tham gia ngày
10 Tháng ba 2018
Bài viết
675
Được thích
1,424
Điểm
360
Nơi ở
Cái Bang
Cho em hỏi nếu viết dưới dạng Application.WorsheetFunction để có thể dùng với nhiều dạng hàm khác thì không được ạ?
Em đọc ở đâu đó không nhớ rõ nhưng nếu mà sử dụng Application.WorsheetFunction thì phải thêm gỡ lỗi nữa thì phải..Cái Áp pờ li ca ti on khác với cái Áp pờ li ca ti on guốc sít phăn thì phải.Ôi khó đi ..
 
Lần chỉnh sửa cuối:

truongvu317

Thành viên tiêu biểu
Tham gia ngày
15 Tháng mười một 2010
Bài viết
465
Được thích
356
Điểm
410
Em đọc ở đâu đó không nhớ rõ nhưng nếu mà sử dụng Application.WorsheetFunction thì phải thêm gỡ lỗi nữa thì phải..Cái Áp pờ li ca ti on khác với cái Áp pờ li ca ti on guốc sít phăn thì phải.Ôi khó đi ..
Dùng cái nào đi nữa đều phải chủ động bẫy lỗi, ví dụ với cái vlookup chẳng hạn, Application.WorsheetFunction khi không dò được thì phát sinh lỗi. Với application tuy không phát sinh lỗi thực thi, nhưng kết quả của nó là Na, vẫn phải bẫy trường hợp này, nếu không code cũng teo.
 

♫ђöล♥ßล†♥†µ♫

Thành viên tiêu biểu
Tham gia ngày
10 Tháng ba 2018
Bài viết
675
Được thích
1,424
Điểm
360
Nơi ở
Cái Bang
Dùng cái nào đi nữa đều phải chủ động bẫy lỗi, ví dụ với cái vlookup chẳng hạn, Application.WorsheetFunction khi không dò được thì phát sinh lỗi. Với application tuy không phát sinh lỗi thực thi, nhưng kết quả của nó là Na, vẫn phải bẫy trường hợp này, nếu không code cũng teo.
Em không biết 1 tẹo tiếng anh nào. Nhưng google họ dịch như thế này
Mã:
Thí dụ

Mã số:
Phạm vi ("A1") .Giá trị = Ứng dụng.WorksheetFunction.Vlookup (.....)
Nếu Vlookup không tìm thấy một kết quả phù hợp (# N / A khi được viết trong một ô)
Sau đó, mã của bạn ngừng chạy và bạn nhận được cửa sổ gỡ lỗi.

nếu bạn làm như thế này
Mã số:
x = Application.Vlookup (.....)
Nó không còn dừng lại với gỡ lỗi.
Thay vào đó, biến x được gán giá trị lỗi và mã tiếp tục chạy.
 

truongvu317

Thành viên tiêu biểu
Tham gia ngày
15 Tháng mười một 2010
Bài viết
465
Được thích
356
Điểm
410
Em không biết 1 tẹo tiếng anh nào. Nhưng google họ dịch như thế này
Mã:
Thí dụ

Mã số:
Phạm vi ("A1") .Giá trị = Ứng dụng.WorksheetFunction.Vlookup (.....)
Nếu Vlookup không tìm thấy một kết quả phù hợp (# N / A khi được viết trong một ô)
Sau đó, mã của bạn ngừng chạy và bạn nhận được cửa sổ gỡ lỗi.

nếu bạn làm như thế này
Mã số:
x = Application.Vlookup (.....)
Nó không còn dừng lại với gỡ lỗi.
Thay vào đó, biến x được gán giá trị lỗi và mã tiếp tục chạy.
Bạn cứ thử đi, biết liền, những điều tớ nói hoàn toàn tương đồng với google dịch.
 
Top Bottom