Chuyên mục xử lý, gỡ rối code VBA

Liên hệ QC
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,918
Mở đầu là câu hỏi của bạn MinhKhai:
Mình có đoạn Code sau, không hiểu lỗi do đâu và cách khắc phục
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 3 And Target.Row > 11 And Target.Row < 17 Then
        If Target.Rows.Count = 1 Then
            If Target.Value <> "" Then
                Target.Offset(0, 1).Value = 1
                Target.Offset(0, 3).Value =  WorksheetFunction.VLookup(Target.Value,  Sheets("BangGia").Range("C2:E100"), 3, False)
                Target.Offset(0, 30).Value = Date
                Target.Offset(0, 31).Value = Now
            Else
                Target.Offset(0, 1).ClearContents
                Target.Offset(0, 3).ClearContents
                Target.Offset(0, 30).ClearContents
                Target.Offset(0, 31).ClearContents


            End If
        End If
    End If
 End Sub

Khi nhập dữ liệu từ C12 đến C16 (target) thì không sao, tuy nhiên khi xóa dữ liệu trong các ô này thì gặp lỗi Type Mismatch

Tôi cũng nghĩ chắc hẳn do ô target đang bị merge với nhiều ô khác dẫn đến việc offset bị sai. Nhưng sao khi
Target.Offset(0, 30).Value = Date
Target.Offset(0, 31).Value = Now
thì chạy tốt mà khi
Target.Offset(0, 30).ClearContents
Target.Offset(0, 31).ClearContents
thì lỗi ???

File kèm
https://dl.dropboxusercontent.com/s...arwIwX4RIr4-mIKjjGlAtkc2rDNZQwP9o1Hg9zbw&dl=1
 
Upvote 0
@ MinhKhai:
Đúng như bạn nhận định, vấn đề nằm ở chỗ các ô được merge lại với nhau. Bạn sửa lại như vầy là được:
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Column = 3 And Target.Row > 11 And Target.Row < 17 Then
        If Target.Rows.Count = 1 Then
            If Target[COLOR=#ff0000][B](1, 1)[/B][/COLOR].Value <> "" Then
                Target.Offset(, 1).Value = 1
                Target.Offset(, 3).Value = WorksheetFunction.VLookup(Target.Value, Sheets("BangGia").Range("C2:E100"), 3, False)
                Target.Offset(, 30).Value = Date
                Target.Offset(, 31).Value = Now
            Else
                Target.Offset(, 1)[COLOR=#ff0000][B] = ""[/B][/COLOR]
                Target.Offset(, 3)[COLOR=#ff0000][B] = ""[/B][/COLOR]
                Target.Offset(, 30).ClearContents
                Target.Offset(, 31).ClearContents
            End If
        End If
    End If
    [B][COLOR=#0000cd]Application.ScreenUpdating = True[/COLOR][/B]
 End Sub
Hoặc chỗ màu đỏ thứ 2 và 3 được sửa lại là:
Mã:
Target.Offset(, 1)[COLOR=#ff0000][B].Resize(, 2)[/B][/COLOR].ClearContents
Target.Offset(, 3)[COLOR=#ff0000][B].Resize(, 3)[/B][/COLOR].ClearContents
Còn vấn đề thứ hai thì tôi thấy bình thường, vì các ô Target.Offset(, 30) và Target.Offset(, 31) là các ô đơn (không merge) nên .ClearContents hay .Value = "" có tác dụng gần như nhau (thực tế không phải vậy nhưng ít ra thì nhìn vào là nó như vậy)
Chỗ màu xanh là tôi thêm vào, việc này là cần thiết nếu trước đó có câu lệnh Application.ScreenUpdating = False
 
Upvote 0
@ MinhKhai:
Đúng như bạn nhận định, vấn đề nằm ở chỗ các ô được merge lại với nhau. Bạn sửa lại như vầy là được:
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Column = 3 And Target.Row > 11 And Target.Row < 17 Then
        If Target.Rows.Count = 1 Then
            If Target[COLOR=#ff0000][B](1, 1)[/B][/COLOR].Value <> "" Then
                Target.Offset(, 1).Value = 1
                Target.Offset(, 3).Value = WorksheetFunction.VLookup(Target.Value, Sheets("BangGia").Range("C2:E100"), 3, False)
                Target.Offset(, 30).Value = Date
                Target.Offset(, 31).Value = Now
            Else
                Target.Offset(, 1)[COLOR=#ff0000][B] = ""[/B][/COLOR]
                Target.Offset(, 3)[COLOR=#ff0000][B] = ""[/B][/COLOR]
                Target.Offset(, 30).ClearContents
                Target.Offset(, 31).ClearContents
            End If
        End If
    End If
    [B][COLOR=#0000cd]Application.ScreenUpdating = True[/COLOR][/B]
 End Sub
Hoặc chỗ màu đỏ thứ 2 và 3 được sửa lại là:
Mã:
Target.Offset(, 1)[COLOR=#ff0000][B].Resize(, 2)[/B][/COLOR].ClearContents
Target.Offset(, 3)[COLOR=#ff0000][B].Resize(, 3)[/B][/COLOR].ClearContents
Còn vấn đề thứ hai thì tôi thấy bình thường, vì các ô Target.Offset(, 30) và Target.Offset(, 31) là các ô đơn (không merge) nên .ClearContents hay .Value = "" có tác dụng gần như nhau (thực tế không phải vậy nhưng ít ra thì nhìn vào là nó như vậy)
Chỗ màu xanh là tôi thêm vào, việc này là cần thiết nếu trước đó có câu lệnh Application.ScreenUpdating = False
Còn nếu là tôi thì tôi đề xuất sửa lại cách bố trí dữ liệu

Capture.JPG





















Tôi thấy chẳng có gì khó khăn cả. Xem chi tiết tại sheet mới tạo nhé
 

File đính kèm

  • BanHang.xls
    87.5 KB · Đọc: 519
Upvote 0
Chân thành các bác đã chia sẻ kinh nghiệm. Qua file này em thấy bỡ ngỡ nhiều vấn đề, và sẽ nhờ mọi người dần dần.

Còn nếu là tôi thì tôi đề xuất sửa lại cách bố trí dữ liệu
Tôi thấy chẳng có gì khó khăn cả. Xem chi tiết tại sheet mới tạo nhé
Cảm ơn bác ndu96081631 đã gợi ý về việc bố trí dữ liệu.
Thú thật với bác, em dùng Excel nhưng không có ưa mấy cái vụ Merge các cell lại với nhau, vì khi các ô được merge với nhau thì rất khó khăn khi xử lý dữ liệu (dù dùng VBA hay không).
Cái file gửi kèm của em ban đầu không bị merge ô nào cả, nhưng khi in thử, các thông tin thò thụt, thiếu diện tích hiển thị.... vì thế em cho thu hẹp các cột, tạo "lưới toạ độ" để dễ dàng phân bố dữ liệu.. hi hi. Em cũng nghĩ đến việc nhập dữ liệu tại 1 sheet, form in dữ liệu tại sheet khác cho "tiện cả đôi đường". Tuy nhiên như thế có vẻ rườm rà vì thực tế em còn 1 sheet NhatKy nữa. Em đã thiết kế 1 nút lệnh để ngoài việc PrintOut thì nó còn "tập hợp" các thông tin trên Hoá đơn này vào 1 dòng trên sheet NhatKy.

nghiaphuc đã viết:
Đúng như bạn nhận định, vấn đề nằm ở chỗ các ô được merge lại với nhau. Bạn sửa lại như vầy là được
Cám ơn bác đã chỉ dẫn.
Em cũng đã thử vọc bằng cách cho ô cần xoá bị ghi đè bằng ký tự trắng ("") hoặc giá trị 0. Tuy nhiên vẫn bị lỗi. Vấn đề là ở chỗ em không biết sửa chô này: If Target(1, 1).Value <> "" Then. Vậy bác làm ơn giải thích 1 chút cho em chỗ này và chỗ .Resize(, 2). (Em cũng đọc nhanh về rezise nhưng chưa hiểu hết)

Ngoài ra các bác cho em hỏi, đoạn code của em khi viết được bọc bởi
Mã:
 [\code] mà diện tích hiển thị nhỏ thế, không được rộng rãi hiển thị như của các bác
 
Upvote 0
Mình tìm trên internet được đoạn code sau, mục đích là tự động vào trang và điền username, nhưng khi run thì chỉ vào được trang mà không tự động điền username "ctyvanha" và bị báo lỗi "run time eror '438' object doesn't support this property or method", mình là gà mờ, mong được giải thích và sửa hộ. Cảm ơn nhiều.


Private Sub LoginGPS()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True


ie.navigate "http://gps2.binhanh.com.vn/"


Do
DoEvents
Loop Until ie.readyState = 4


Set allHyperlink = ie.document.getelmentbytagname("a")
For Each hyper_link In allhyperlinks
If hyper_link.innerText = "sign in" Then
hyper_link.Click
Exit For
End If
Next


Do
DoEvents
Loop Until ie.readyState = 3


Do
DoEvents
Loop Until ie.readyState = 4




SendKeys "ctyvanha"
SendKeys "{tab}"
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mình tìm trên internet được đoạn code sau, mục đích là tự động vào trang và điền username, nhưng khi run thì chỉ vào được trang mà không tự động điền username "ctyvanha" và bị báo lỗi "run time eror '438' object doesn't support this property or method", mình là gà mờ, mong được giải thích và sửa hộ. Cảm ơn nhiều.


Private Sub LoginGPS()
Dim ie As Object
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True


ie.navigate "http://gps2.binhanh.com.vn/"


Do
DoEvents
Loop Until ie.readyState = 4


Set allHyperlink = ie.document.getelmentbytagname("a")
For Each hyper_link In allhyperlinks
If hyper_link.innerText = "sign in" Then
hyper_link.Click
Exit For
End If
Next


Do
DoEvents
Loop Until ie.readyState = 3


Do
DoEvents
Loop Until ie.readyState = 4




SendKeys "ctyvanha"
SendKeys "{tab}"
End Sub

Mục đích duy nhất của bạn là: truy cập vào trang web --> điền user và password vào 2 ô --> nhấn nút "Đăng nhập"? Nếu thế thì thử code sau. Tôi không có mặt khẩu, vậy chỗ đỏ đỏ bạn viết mật khẩu vào

Mã:
Private Sub LoginGPS()
Dim ie As Object, doc As Object, txtPwd As Object, txtUsr As Object, btn As Object
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    
    ie.navigate "http://gps2.binhanh.com.vn/"
    
    Do
        DoEvents
    Loop Until ie.readyState = 4
    
    Set doc = ie.document
    
    Set txtUsr = doc.all.Item("UserLogin1_txtLoginUserName")
    Set txtPwd = doc.all.Item("UserLogin1_txtLoginPassword")
    Set btn = doc.all.Item("UserLogin1_btnLogin")
    
    txtUsr.Value = "ctyvanha"
    txtPwd.Value = "[B][COLOR=#ff0000]mat_khau[/COLOR][/B]"

    btn.Click
End Sub
 
Upvote 0
Cảm ơn bạn rất nhiều, nhưng nếu như mình chỉ muốn điền thông tin thôi chứ không muốn tự động nhấn nút đăng nhập thì bỏ đoạn code "btn.click" đúng không ạ
 
Upvote 0
Cảm ơn bạn rất nhiều, nhưng nếu như mình chỉ muốn điền thông tin thôi chứ không muốn tự động nhấn nút đăng nhập thì bỏ đoạn code "btn.click" đúng không ạ

Dĩ nhiên rồi. Thậm chí tôi cho btn.Click đứng riêng ra (có dòng trống ở trước) cho dễ nhìn, dễ phát hiện.
Mà bạn tự bỏ đi rồi thấy "mặt mũi" chúng ra sao chứ cần gì phải hỏi?

Mà lần sau trả lời ai thì bạn nên trích một đoạn như tôi đã làm. Luyện cho thành thói quen chứ về sau nhiều bài mà làm thế thì chả biết bạn muốn hỏi, góp ý, phê bình ai
 
Lần chỉnh sửa cuối:
Upvote 0
giải đáp công thức

anh nào giúp em giải thích dùm em code bên dưới nha



Function isOK(strName As String) As Boolean
isOK = True
Dim strComputerName As String
Dim strProcessorID As String
Dim objWMIService, colItems, objItem
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Processor", , 48)
For Each objItem In colItems
strProcessorID = objItem.ProcessorID
strComputerName = objItem.SystemName
Next
Dim anlName As String
Dim anlCPUID As String
Dim anlDate As String
Dim anlCode As String
Dim i%, j%
Dim strKey As String
i = 1: j = 0
Do While i <= Len(strName)
strKey = Mid(strName, i, 1)
If strKey = "ö" Then
j = j + 1
Select Case j
Case 1
anlName = Left(strName, i - 1)
Case 2
anlCPUID = Left(strName, i - 1)
Case 3
anlDate = Left(strName, i - 1)
strName = Right(strName, Len(strName) - i)
Exit Do
End Select
strName = Right(strName, Len(strName) - i)
i = 1
Else
i = i + 1
End If
Loop
anlCode = strName
If anlCode <> GenerateCode(strProcessorID, CDate(anlDate)) Then isOK = False
If anlCPUID <> strProcessorID Then isOK = False
If anlName <> strComputerName Then isOK = False
If Round(Now - CDate(anlDate)) + 1 > 120 Then isOK = False
If Round(Now - CDate(anlDate)) + 1 < 0 Then isOK = False
End Function



em chân thành cảm ơn
 
Upvote 0
Xin giúp đỡ về gỡ code VBA tự tạo T^T
Do học code chưa đến nơi đến chốn mà lại còn táy máy tự vọc code VBA, mình làm một đoạn code dùng chung với mục đích khi bấm Ctrl Shift T sẽ save as file excel sang pdf, nhưng bị lỗi, giờ cứ mở excel lên là đoạn code đó lại chạy ra mặc dù đã xóa code đi rồi. Excel tự mở file PERSONAL.XLSB
Đã thử Google tìm giải pháp, xóa C:\Documents and Settings\XXXXXXXXX\Application Data\Microsoft\Excel\XLSTART\, hide đủ kiểu vẫn không vô hiệu hóa được cái này.
 

File đính kèm

  • untitled.JPG
    untitled.JPG
    203 KB · Đọc: 448
Lần chỉnh sửa cuối:
Upvote 0
Dĩ nhiên rồi. Thậm chí tôi cho btn.Click đứng riêng ra (có dòng trống ở trước) cho dễ nhìn, dễ phát hiện.
Mà bạn tự bỏ đi rồi thấy "mặt mũi" chúng ra sao chứ cần gì phải hỏi?

Mà lần sau trả lời ai thì bạn nên trích một đoạn như tôi đã làm. Luyện cho thành thói quen chứ về sau nhiều bài mà làm thế thì chả biết bạn muốn hỏi, góp ý, phê bình ai
Vâng, lần sau sẽ rút kinh nghiệm, cho mình hỏi thêm chút nữa là nếu thay vì dùng ie thì mình dùng firefox hoặc chrome được không, nếu được thì code thay đổi như thế nào. Cảm ơn
 
Upvote 0
anh nào giúp em giải thích dùm em code bên dưới nha



Function isOK(strName As String) As Boolean
isOK = True
Dim strComputerName As String
Dim strProcessorID As String
Dim objWMIService, colItems, objItem
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Processor", , 48)
For Each objItem In colItems
strProcessorID = objItem.ProcessorID
strComputerName = objItem.SystemName
Next
Dim anlName As String
Dim anlCPUID As String
Dim anlDate As String
Dim anlCode As String
Dim i%, j%
Dim strKey As String
i = 1: j = 0
Do While i <= Len(strName)
strKey = Mid(strName, i, 1)
If strKey = "ö" Then
j = j + 1
Select Case j
Case 1
anlName = Left(strName, i - 1)
Case 2
anlCPUID = Left(strName, i - 1)
Case 3
anlDate = Left(strName, i - 1)
strName = Right(strName, Len(strName) - i)
Exit Do
End Select
strName = Right(strName, Len(strName) - i)
i = 1
Else
i = i + 1
End If
Loop
anlCode = strName
If anlCode <> GenerateCode(strProcessorID, CDate(anlDate)) Then isOK = False
If anlCPUID <> strProcessorID Then isOK = False
If anlName <> strComputerName Then isOK = False
If Round(Now - CDate(anlDate)) + 1 > 120 Then isOK = False
If Round(Now - CDate(anlDate)) + 1 < 0 Then isOK = False
End Function



em chân thành cảm ơn



Đây là code VBA hay VBScript?
Bạn tự giải thích trước những gì bạn hiểu và đưa lên đây. Chỗ nào không đúng thì bà con sẽ giúp.

Nếu bạn không hiểu gì cả thì cóp code về làm cái quái gì?
 
Lần chỉnh sửa cuối:
Upvote 0
Vâng, lần sau sẽ rút kinh nghiệm, cho mình hỏi thêm chút nữa là nếu thay vì dùng ie thì mình dùng firefox hoặc chrome được không, nếu được thì code thay đổi như thế nào. Cảm ơn

Cái này thú thực là tôi không biết. Không tìm hiểu và không biết cách truy cập tới các object của firefox. Interface của IE thì tôi có thể tìm đọc vd. trên trang của Microsoft chứ của firefox thì không biết tìm ở đâu. Mà thực ra tôi cũng chưa tìm bao giờ vì tôi cũng chả quan tâm. Các interface của IE thì tôi đã biết từ rất lâu, từ khi lập trình trong Delphi.

Nói qua về code dùng IE. Ta phải "lấy" được interface (object) IHTMLDocument2 (3), tức ie.document. Rồi thì dùng các property và method của interface thôi.

Còn firefox có những interface nào và các thuộc tính, phương thức ra sao thì tôi chịu.
 
Upvote 0
Cái này thú thực là tôi không biết. Không tìm hiểu và không biết cách truy cập tới các object của firefox. Interface của IE thì tôi có thể tìm đọc vd. trên trang của Microsoft chứ của firefox thì không biết tìm ở đâu. Mà thực ra tôi cũng chưa tìm bao giờ vì tôi cũng chả quan tâm. Các interface của IE thì tôi đã biết từ rất lâu, từ khi lập trình trong Delphi.

Nói qua về code dùng IE. Ta phải "lấy" được interface (object) IHTMLDocument2 (3), tức ie.document. Rồi thì dùng các property và method của interface thôi.

Còn firefox có những interface nào và các thuộc tính, phương thức ra sao thì tôi chịu.
Nói chung dùng ie cũng được rồi, chạy rất ổn rồi, mình đã sử dụng được với các trang quản lý khác của công ty. Cảm ơn bạn nhiều
 
Upvote 0
Xin Chào ! Các Bác giải Thích Hộ Tôi Code Này Với.

PHP:
Sub CopyVung()
  With Sheets("DS_B")
    .Range("A4:I99").Clear
    Sheets("DS_A").Range("A4:I99" & Sheets("DS_A").Range("A99").End(xlUp).Row).Copy .Range("A4")
  End With
End Sub

ĐANG TẬP TÀNH VBA, CÁC BÁC HƯỚNG DẪN TÔI ĐOẠN CODE TRÊN VỚI
 

File đính kèm

  • CopyDS LAM XONG XOA.rar
    20.8 KB · Đọc: 75
Upvote 0
Nhờ sửa giúp đọan code

Đang làm thì gặp rắc rối chỗ này: (các bạn xem file)

Sheets("BANHANG-TRAHANG").Range(.Cells(j, B), .Cells(i, B)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

nhờ các bác giúp dùm. chỗ chữ to là nó báo lỗi
 

File đính kèm

  • Hoi.xlsm
    35.3 KB · Đọc: 56
Upvote 0
Đang làm thì gặp rắc rối chỗ này: (các bạn xem file)

Sheets("BANHANG-TRAHANG").Range(.Cells(j, B), .Cells(i, B)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

nhờ các bác giúp dùm. chỗ chữ to là nó báo lỗi

Đoạn code ấy có thể thay bằng:
Mã:
With Sheets("BANHANG-TRAHANG")
  .Range(.Cells(j, B), .Cells(i, B)).PasteSpecial Paste:=xlPasteValues
End With
Anh Bill sẽ không hiểu bạn nói cái màu đỏ ở trên là cái gì đâu nếu không có With trước đó
 
Upvote 0
Đoạn code ấy có thể thay bằng:
Mã:
With Sheets("BANHANG-TRAHANG")
  .Range(.Cells(j, B), .Cells(i, B)).PasteSpecial Paste:=xlPasteValues
End With
Anh Bill sẽ không hiểu bạn nói cái màu đỏ ở trên là cái gì đâu nếu không có With trước đó

Sư phụ xem giúp em lại cái code này:
Số hóa đơn nó không copy qua được
Mục đích của code là khi nhấn nút save thì tòan bộ dữ liệu bên sheet HD BAN HANG sẽ được copy qua và lưu laij ở sheet BAN HANG - TRA HANG
Riêng số hóa đơn thì có bao nhiêu mặt hàng thì copy số hóa đơn đó qua sheet BAN HANG - TRA HANG bấy nhiêu dòng
 
Lần chỉnh sửa cuối:
Upvote 0
With Sheets("BANHANG-TRAHANG")
.Range(.Cells(j, B), .Cells(i, B)).PasteSpecial Paste:=xlPasteValues
End With
Đã thay theo cách của sư phụ nhưng nó vẫn không copy số hóa đơn qua được
Nhờ các bạnchir giáo thêm.
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT
Back
Top Bottom