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
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 ???
@ 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
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
@ 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
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ả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
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
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
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
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 ạ
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
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
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.
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
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
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
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
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
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.