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

Ba Tê · 9/9/14

matkinh đã viết:
mình có tập viết code so sánh dữ liệu cột c và cột G nếu khi nhập dữ liệu vào cột c vượt quá số lương cột G thì thông báo xong rồi xoá tại Cells đó luôn. và nếu nhập dữ liệu vào không phải là số VD như: chữ hay ký tự đặc biệt VV thì cũng xoá luôn...hiện tại phát sinh lỗi khi mình xoá dữ liệu cột C...
Mong các bạn trợ giúp xử lý lỗi và giúp mình hoàn thiện code sau
xin cảm ơn

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)If Not Intersect(Target, [C5:C1000]) Is Nothing Then If Target.Value > Target.Offset(, 4) Then MsgBox "Da qua so luong" Target = "" Target.Select Else If Not IsNumeric(Target) Then Target = "" Target.Select End If Cells(Target.Row, 8) = Format(Now, "hh:mm:ss") End If End IfEnd Sub

Thêm 1 cái IF nữa xem sao, Code này của bạn à nghe, Kết quả có thế nào là của bạn

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C5:C1000]) Is Nothing Then
    If Target.Rows.Count = 1 Then ' Thêm cái này'
        If Target.Value > Target.Offset(, 4) Then
            MsgBox "Da qua so luong"
            Target = ""
            Target.Select
        Else
            If Not IsNumeric(Target) Then
                Target = ""
                Target.Select
            End If
            Cells(Target.Row, 8) = Format(Now, "hh:mm:ss")
        End If
    End If
End If
End Sub

phihndhsp · 9/9/14

matkinh đã viết:
Cảm ơn bạn như vậy Tốt rồi .. nhưng khi mình khi mình nhập chữ m hay a vô thì nó vẫn báo đã quá số lượng .nếu được bạn viết vho mình code khác với .yêu cầu vẫn vậy
Xin cảm ơn Bạn nhiều

cái này là do không rõ ràng về kiểu dữ liệu nên nó báo lỗi là đúng, nếu mình nhập vào là số thì nó sẽ so sánh với số, còn nếu mình nhập 1 bên chuỗi 1 bên số thì nó sẽ tự động lấy cái chuỗi so sánh với số theo bảng mã lúc đó thì không còn đúng với yêu cầu của mình nữa. VBA nó rất thoải mái về các kiểu dữ liệu muốn gán kiểu nào gán muốn xài kiểu nào xài chính vì vậy bình thường mình sẽ thấy nó rất dễ xài và không sai cú pháp. Nhưng cái này rất nguy hiểm với dân lập trình, sai cú pháp thì còn biết đường mà sửa chứ sai phép tính thì chỉ có mò mà thôi

Ba Tê · 9/9/14

matkinh đã viết:
Ý mình phòng khi nhập sai dữ liệu thì nó xoá đi thôi. để mình biết nhập lại vì nhiều khi mình hay nhập ẩu lắm nên mới nghĩ ra vậy mong các bạn trợ giúp
xin cảm ơn

Thử lại với cái này xem:

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C5:C1000]) Is Nothing Then
    If Target.Rows.Count = 1 Then ' Thêm cái này'
        Cells(Target.Row, 8) = Format(Now, "hh:mm:ss")
        If IsNumeric(Target) Then
            If Target.Value > Target.Offset(, 4) Then
                MsgBox "Da qua so luong"
                Target = ""
                Cells(Target.Row, 8) = Empty
                Target.Select
            End If
        Else
            MsgBox "Khong phai Number"
            Target = ""
            Cells(Target.Row, 8) = Empty
            Target.Select
        End If
    End If
End If
End Sub

VetMini · 10/9/14

matkinh đã viết:
Ý mình phòng khi nhập sai dữ liệu thì nó xoá đi thôi. để mình biết nhập lại vì nhiều khi mình hay nhập ẩu lắm nên mới nghĩ ra vậy mong các bạn trợ giúp
xin cảm ơn

Code gì mà non tay quá. Nhập xong rồi xoá thì người nhập làm sao biết tại sao dữ liệu ấy không được chấp nhận?

MsgBox Target.Value & ": không phải là con số"
MsgBox Target.Value & ": vượt cao hơn giới hạn " & Target.Offset(,4).Value

Kiều Mạnh · 10/9/14

VetMini đã viết:
Code gì mà non tay quá. Nhập xong rồi xoá thì người nhập làm sao biết tại sao dữ liệu ấy không được chấp nhận?

MsgBox Target.Value & ": không phải là con số"
MsgBox Target.Value & ": vượt cao hơn giới hạn " & Target.Offset(,4).Value

Học thêm bạn một kiểu Msgbox Hay

boydaigai · 10/9/14

Ở đề tài này e hỏi đã bị khoá : http://www.giaiphapexcel.com/forum/...iêu-đề-thế-nào-cho-bật-được-nội-dung-cần-hỏi)

E loay hoay mãi mà vẫn ko sử dụng được không biết cách sử dụng find method của e sai ở đâu - - - - - -
Kính mong đc khai sáng cái đầu - - - - - - - - -

Pon1 · 10/9/14

nghiaphuc đã viết:
Trong file của bạn, tên sheet "Vibration Test" bị dư 1 dấu cách ở cuối, còn tên sheet "Aux.Speed Adj.Unit" thì dư 1 dấu cách ở đầu. Bạn xóa mấy cái dấu cách này đi là được, hoặc sửa trong code thành "Vibration Test " và " Aux.Speed Adj.Unit"

cám ơn anh, em đã làm được rùi ạ. vậy mà em tìm mãi không ra ... hihi::

boydaigai · 10/9/14

boydaigai đã viết:
Ở đề tài này e hỏi đã bị khoá : http://www.giaiphapexcel.com/forum/...iêu-đề-thế-nào-cho-bật-được-nội-dung-cần-hỏi)

E loay hoay mãi mà vẫn ko sử dụng được không biết cách sử dụng find method của e sai ở đâu - - - - - -
Kính mong đc khai sáng cái đầu - - - - - - - - -

Ai gỡ rối cho e bài này được không, yêu câù e ghi hết ở #310 $-\\/.$ $-\\/.$

Ba Tê · 10/9/14

boydaigai đã viết:
Ai gỡ rối cho e bài này được không, yêu câù e ghi hết ở #310 $-\\/.$ $-\\/.$

Không dùng Find gì đó được không?

PHP:

Private Sub CommandButton1_Click()
Dim Arr(), I As Long
Arr = Range([F9], [F65536].End(xlUp)).Value2
For I = UBound(Arr, 1) To 1 Step -1
    If UCase(Left(Arr(I, 1), 1)) = "X" Then
        [D5] = "X" & Format(Right(Arr(I, 1), 4) + 1, "0000")
        Exit For
    End If
Next I
End Sub

boydaigai · 10/9/14

Ba Tê đã viết:
Không dùng Find gì đó được không?

PHP:

Private Sub CommandButton1_Click() Dim Arr(), I As Long Arr = Range([F9], [F65536].End(xlUp)).Value2 For I = UBound(Arr, 1) To 1 Step -1 If UCase(Left(Arr(I, 1), 1)) =

huuthang_bd · 10/9/14

boydaigai đã viết:
E cảm ơn, biết thêm 1 cách
Nhưng e vẫn hơi thắc mắc cách dùng find, tìm ngược từ dưới lên xlprevious áp dụng vào bài này sao cứ báo error hoài

Biến Rng là biến đối tượng nên khi gán bạn phải dùng từ khóa Set

PHP:

Set rng = ...

Ngoài ra còn một số vấn đề khác:
1. Khi dùng Find, bạn phải bẫy lỗi trong trường hợp không tìm thấy (không có dữ liệu thỏa điều kiện)
2. 'Tìm range hàng cuối cùng có chữ "X" đầu tiên' thì chuỗi tìm kiếm của bạn phải là "X*" chứ không phải là "*X*"
3. Cách 'Cộng thêm 1' của bạn và anh Ba Tê sẽ có kết quả khác nhau nếu dữ liệu tìm được là X9999.
- Của bạn kết quả là: X0000
- Của anh Ba Tê kết quả là: X10000
Vì vậy, tùy vào kết quả mà bạn muốn mà chọn cách phù hợp.

boydaigai · 10/9/14

huuthang_bd đã viết:
Biến Rng là biến đối tượng nên khi gán bạn phải dùng từ khóa Set

PHP:

Set rng = ...

Ngoài ra còn một số vấn đề khác:
1. Khi dùng Find, bạn phải bẫy lỗi trong trường hợp không tìm thấy (không có dữ liệu thỏa điều kiện)
2. 'Tìm range hàng cuối cùng có chữ

boydaigai · 10/9/14

E hỏi thêm giả sử không tìm thấy dữ liệu thỏa mãn điều kiện có chữ cái đầu là X thì cho kết quả trả về X0000. Thì sẽ đc xử lý thế nào ạ -0-/.

lhthai · 11/9/14

Chào Các Anh GPE
Mình tìm trên trang diễn dàn có code sau nay muốn sửa kết quả copy trả về Value được không

Mã:

[TABLE="width: 623"]
[TR]
[TD]Private Sub Copysheet_Click()[/TD]
[/TR]
[TR]
[TD]With Application.FileDialog(1)[/TD]
[/TR]
[TR]
[TD]        .InitialFileName = ThisWorkbook.Path[/TD]
[/TR]
[TR]
[TD]        .Title = "Chon file nguon"[/TD]
[/TR]
[TR]
[TD]        .FilterIndex = 3[/TD]
[/TR]
[TR]
[TD]        .AllowMultiSelect = False[/TD]
[/TR]
[TR]
[TD]        Do[/TD]
[/TR]
[TR]
[TD]            .Show[/TD]
[/TR]
[TR]
[TD]            If .SelectedItems.Count = 0 Then Exit Sub[/TD]
[/TR]
[TR]
[TD]            If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"[/TD]
[/TR]
[TR]
[TD]        Loop Until .SelectedItems(1) <> ThisWorkbook.FullName[/TD]
[/TR]
[TR]
[TD]        With Workbooks.Open(.SelectedItems(1))[/TD]
[/TR]
[TR]
[TD][COLOR=#ff0000]            .Sheets(1).Range("A1:F20").Copy ThisWorkbook.Sheets(1).[A1][/COLOR][/TD]
[/TR]
[TR]
[TD][COLOR=#ff0000]            .Sheets(1).Range("A28:M200").Copy ThisWorkbook.Sheets(1).[A28][/COLOR][/TD]
[/TR]
[TR]
[TD]            .Close False[/TD]
[/TR]
[TR]
[TD]        End With[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[TR]
[TD]End Sub

[/TD]
[/TR]
[/TABLE]

Let'GâuGâu · 11/9/14

lhthai đã viết:

Chào Các Anh GPE
Mình tìm trên trang diễn dàn có code sau nay muốn sửa kết quả copy trả về Value được không

Mã:

[TABLE="width: 623"]
[TR]
[TD]Private Sub Copysheet_Click()[/TD]
[/TR]
[TR]
[TD]With Application.FileDialog(1)[/TD]
[/TR]
[TR]
[TD]        .InitialFileName = ThisWorkbook.Path[/TD]
[/TR]
[TR]
[TD]        .Title = "Chon file nguon"[/TD]
[/TR]
[TR]
[TD]        .FilterIndex = 3[/TD]
[/TR]
[TR]
[TD]        .AllowMultiSelect = False[/TD]
[/TR]
[TR]
[TD]        Do[/TD]
[/TR]
[TR]
[TD]            .Show[/TD]
[/TR]
[TR]
[TD]            If .SelectedItems.Count = 0 Then Exit Sub[/TD]
[/TR]
[TR]
[TD]            If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"[/TD]
[/TR]
[TR]
[TD]        Loop Until .SelectedItems(1) <> ThisWorkbook.FullName[/TD]
[/TR]
[TR]
[TD]        With Workbooks.Open(.SelectedItems(1))[/TD]
[/TR]
[TR]
[TD][COLOR=#ff0000]            .Sheets(1).Range("A1:F20").Copy ThisWorkbook.Sheets(1).[A1][/COLOR]
[/TD]
[/TR]
[TR]
[TD][COLOR=#ff0000]            .Sheets(1).Range("A28:M200").Copy ThisWorkbook.Sheets(1).[A28][/COLOR]
[/TD]
[/TR]
[TR]
[TD]            .Close False[/TD]
[/TR]
[TR]
[TD]        End With[/TD]
[/TR]
[TR]
[TD]    End With[/TD]
[/TR]
[/TABLE]

bạn có thể dùng special paste

Mã:

[COLOR=#ff0000] .Sheets(1).Range("A1:F20").Copy 
ThisWorkbook.Sheets(1).[A1][/COLOR].specialpaste

[COLOR=#ff0000] .Sheets(1).Range("A28:M200").Copy 
ThisWorkbook.Sheets(1).[A28][/COLOR].specialpaste

hoặc bỏ qua luôn bộ nhớ clipboard

Mã:

[COLOR=#ff0000][COLOR=#ff0000]ThisWorkbook.Sheets(1).[A1:F20][/COLOR].value=.Sheets(1).Range("A1:F20").value

[/COLOR]

Hoàng Trọng Nghĩa · 11/9/14

lhthai đã viết:
Chào Các Anh GPE
Mình tìm trên trang diễn dàn có code sau nay muốn sửa kết quả copy trả về Value được không

Mã:

[TABLE="width: 623"] [TR] [TD][/TD] [/TR] [TR] [TD][COLOR=#ff0000] .Sheets(1).Range("A1:F20").Copy ThisWorkbook.Sheets(1).[A1][/COLOR][/TD] [/TR] [TR] [TD][COLOR=#ff0000] .Sheets(1).Range("A28:M200").Copy ThisWorkbook.Sheets(1).[A28][/COLOR][/TD] [/TR] [TR] [TD]

[/TD]
[/TR]
[/TABLE]

Thay màu đỏ thành:

Mã:

            .Sheets(1).Range("A1:F20").Copy
            ThisWorkbook.Sheets(1).[A1].PasteSpecial 3
            .Sheets(1).Range("A28:M200").Copy
            ThisWorkbook.Sheets(1).[A28].PasteSpecial 3

Hoàng Trọng Nghĩa · 11/9/14

Let'GâuGâu đã viết:
bạn có thể dùng special paste

Mã:

[COLOR=#ff0000] .Sheets(1).Range("A1:F20").Copy ThisWorkbook.Sheets(1).[A1][/COLOR].specialpaste [COLOR=#ff0000] .Sheets(1).Range("A28:M200").Copy ThisWorkbook.Sheets(1).[A28][/COLOR].specialpaste

Nếu đã dùng PasteSpecial thì hoặc là:

Mã:

.PasteSpecial [COLOR=#0000cd]Paste:=xlPasteValues[/COLOR]

Hoặc:

Mã:

.PasteSpecial [COLOR=#0000CD]3[/COLOR]

Chứ nếu không dùng thông số (xanh), thì chúng cũng như Paste bình thường thôi, không hơn không kém.

Vả lại "specialpaste" hình như viết cũng không đúng nữa nhỉ!

lhthai · 11/9/14

Hoàng Trọng Nghĩa đã viết:
[/TD]
[/TR]
[/TABLE]

Thay màu đỏ thành:

Mã:

.Sheets(1).Range("A1:F20").Copy ThisWorkbook.Sheets(1).[A1].PasteSpecial 3 .Sheets(1).Range("A28:M200").Copy ThisWorkbook.Sheets(1).[A28].PasteSpecial 3

Chào Anh
Em copy vào chạy không được em gửi file anh xem nha
File book2 lấy giữ liệu từ các file khác

Hoàng Trọng Nghĩa · 11/9/14

lhthai đã viết:
Chào Anh
Em copy vào chạy không được em gửi file anh xem nha
File book2 lấy giữ liệu từ các file khác

Cụ thể là lỗi gì? Nhận dữ liệu từ file nào?

-----------------------------------------------

Tôi tạm sửa lại thế này cho bạn:

Mã:

Private Sub CopySheet_Click()
With Application.FileDialog(1)
        .InitialFileName = ThisWorkbook.Path
        .Title = "Chon file nguon"
        .FilterIndex = 3
        .AllowMultiSelect = False
        Do
            .Show
            If .SelectedItems.Count = 0 Then Exit Sub
            If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"
        Loop Until .SelectedItems(1) <> ThisWorkbook.FullName
[COLOR=#800080]        Application.DisplayAlerts = False[/COLOR]
[COLOR=#0000ff]        ThisWorkbook.Sheets(1).Cells.ClearContents[/COLOR]
        With Workbooks.Open(.SelectedItems(1))
            .Sheets(1).Range("A1:F20").Copy
[COLOR=#0000ff]            ThisWorkbook.Sheets(1).[A1].PasteSpecial Paste:=xlPasteValues[/COLOR]
            .Sheets(1).Range("A28:M200").Copy
[COLOR=#0000ff]            ThisWorkbook.Sheets(1).[A28].PasteSpecial Paste:=xlPasteValues[/COLOR]
            .Close False
        End With
[COLOR=#800080]        Application.DisplayAlerts = True[/COLOR]
    End With
End Sub

lhthai · 11/9/14

Hoàng Trọng Nghĩa đã viết:

Cụ thể là lỗi gì? Nhận dữ liệu từ file nào?

-----------------------------------------------

Tôi tạm sửa lại thế này cho bạn:

Mã:

Private Sub CopySheet_Click()
With Application.FileDialog(1)
        .InitialFileName = ThisWorkbook.Path
        .Title = "Chon file nguon"
        .FilterIndex = 3
        .AllowMultiSelect = False
        Do
            .Show
            If .SelectedItems.Count = 0 Then Exit Sub
            If .SelectedItems(1) = ThisWorkbook.FullName Then MsgBox "Khong chon file nay!"
        Loop Until .SelectedItems(1) <> ThisWorkbook.FullName
[COLOR=#800080]        Application.DisplayAlerts = False[/COLOR]
[COLOR=#0000ff]        ThisWorkbook.Sheets(1).Cells.ClearContents[/COLOR]
        With Workbooks.Open(.SelectedItems(1))
            .Sheets(1).Range("A1:F20").Copy
[COLOR=#0000ff]            ThisWorkbook.Sheets(1).[A1].PasteSpecial Paste:=xlPasteValues[/COLOR]
            .Sheets(1).Range("A28:M200").Copy
[COLOR=#0000ff]            ThisWorkbook.Sheets(1).[A28].PasteSpecial Paste:=xlPasteValues[/COLOR]
            .Close False
        End With
[COLOR=#800080]        Application.DisplayAlerts = True[/COLOR]
    End With
End Sub

_Rất hay cám ơn anh nha
Em muốn bổ sung thếm 1 điều kiện như sau
Chẳng hạn trong các file em gửi co trường họp sau tên file NVY300 có 18 dòng còn file NVY914 có 21dong
Em muốn khi copy chỉ lấy giá trị của cột A:F & A:M dán qua thôi không biết code có làm được không anh
Em chỉ hỏi thêm vậy thôi

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

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

Huyền thoại GPE

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

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

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

Ăn cùng góc phố

I don't program, I beat code into submission!!!

Thành viên bị đình chỉ hoạt động

File đính kèm

Thành viên mới

Thành viên bị đình chỉ hoạt động

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

Thành viên bị đình chỉ hoạt động

Chuyên gia GPE

Thành viên bị đình chỉ hoạt động

Thành viên bị đình chỉ hoạt động

Thành viên thường trực

Thành viên mới

Chuyên gia GPE

Chuyên gia GPE

Thành viên thường trực

Chuyên gia GPE

Thành viên thường trực

Đếm ngược thời gian