新手尝试在excel工作簿上混合和匹配代码,该工作簿配置为提示登录并允许diff Id和PW查看不同的工作表。
If Me.userid.Value = "admin" And Me.userpw.Value = "admin" Then
MsgBox "Login Successful!", vbInformation, "Login Alert"
MsgBox "Entry and use data with caution and exercise confidentiality at all times!", vbExclamation, "Critical Reminder"
Unload Me
Sheets("Summary Report View").Visible = True
Sheets("Summary Report View").Select
Sheets("Data Validation").Visible = True
Sheets("Data Entry 1").Visible = True
Sheets("Data Entry 2").Visible = True
Sheets("Data Entry 3").Visible = True
我遇到了这个挑战,无法将数据从其他工作簿(一个名为6-9个月的特定工作表)复制到我正在处理数据输入1的工作簿中。条件是拾取所有行这个名字" John"在列I中,粘贴到名为&#34的活动工作簿表;数据输入1"。我试图通过点击按钮激活代码以获取所有行,但它似乎无法正常工作。
Confirmation = MsgBox("Are you sure to removal all contents? This is not reversible", vbYesNo, "Confirmation")
Select Case Confirmation
Case Is = vbYes
Sheets("Data Entry 2").Cells.ClearContents
MsgBox "Information removed", vbInformation, "Information"
Dim GCell As Range
Dim Txt$, MyPath$, MyWB$, MySheet$
Dim myValue As String
Dim P As Integer, Q As Integer
Txt = "John"
MyPath = "C:\Users\gary.tham\Desktop\"
MyWB = "Book1.xlsx"
'MySheet = ActiveSheet.Name
Application.ScreenUpdating = False
Workbooks.Open Filename:=MyPath & MyWB
lastrow = ActiveSheet.Range("A" & Rows.Count).End(x1Up).Row
For i = 2 To lastrow
If Cells(i, 11) = txt Then
Range(Cells(i, 1), Cells(i, 13)).Select
Selection.Copy
P = Worksheets.Count
For Q = 1 To P
If ThisWorkbook.Worksheets(Q).Name = "Data Entry 2" Then
Worksheets("Data Entry 2").Select
ThisWorkbook.Worksheets(Q).Paste
End If
Next Q
End If
Next i
Case Is = vbNo
MsgBox "No Changes Made", vbInformation, "Information"
End Select
答案 0 :(得分:1)
您的代码的基本问题是您正在同时处理多个Excel文件(1)您正在打开的文件并搜索“John”和(2)当前调用宏的文件我们正在导入数据。然而,您的代码并未引用这两个文件,而仅仅指出要在ActiveSheet
中搜索“john”。此外,您没有告诉VBA您要在哪两个文件中搜索当前活动的工作表。
因此,如果您正在使用多个文件,那么您应该专门解决所有问题,并且不要求VBA假设哪个文件或哪个工作表或哪个单元格在哪个工作表中表示您的意思。困惑?如果VBA是一个人,那么他/她可能也会感到困惑。然而,VBA只是做出了假设,而你却想知道为什么代码没有按照你的预期去做。因此,在处理多个文件时,您应该使用以下显式(!)引用并告诉VBA您想要的内容:
Workbooks("Book1.xlsx").Worksheets("Sheet1").Cells(1, 1).Value2
或
Workbooks("Book1.xlsx").Worksheets("Sheet1").Range("A1").Value2
话虽如此,我更改了您的代码以使用上述内容。
Option Explicit
Sub CopyDataFromAnotherFileIfSearchTextIsFound()
Dim strPath As String
Dim wbkImportFile As Workbook
Dim shtThisSheet As Worksheet
Dim shtImportSheet As Worksheet
Dim lngrow As Long
Dim strSearchString As String
Dim strImportFile As String
'uPPer or lOwEr cases do not matter (as it is currently setup)
strSearchString = "jOHn"
strImportFile = "Book1.xlsx"
Set shtThisSheet = ThisWorkbook.Worksheets("Data Entry 2")
'If the import file is in the same folder as the current file
' then you could also use the following instead
'strPath = ThisWorkbook.Path
strPath = "C:\tmp" '"C:Users\gary.tham\Desktop"
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set wbkImportFile = Workbooks.Open(Filename:=strPath & "\" & strImportFile)
'To speed up things you could also (if acceptable) open the file
' read-only without updating links to other Excel files (if there are any):
'Set wbkImportFile = Workbooks.Open(Filename:=strPath & "\" & strImportFile, ReadOnly:=True, UpdateLinks:=False)
Set shtImportSheet = wbkImportFile.Worksheets("6-9months")
shtThisSheet.Cells.ClearContents
For lngrow = 2 To shtImportSheet.Cells(shtImportSheet.Rows.Count, "I").End(xlUp).Row
If InStr(1, shtImportSheet.Cells(lngrow, "I").Value2, strSearchString, vbTextCompare) > 0 Then
shtImportSheet.Range(shtImportSheet.Cells(lngrow, 1), shtImportSheet.Cells(lngrow, 13)).Copy
shtThisSheet.Range("A" & shtThisSheet.Cells(shtThisSheet.Rows.Count, "A").End(xlUp).Row + 1).PasteSpecial xlPasteAll, xlPasteSpecialOperationNone
End If
Next lngrow
wbkImportFile.Close SaveChanges:=False
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub
请注意,上述代码并非您的完整副本。有两个变化:
(1)当前文件(您要导入的文件)中的“数据输入2”表将被清除,而不会询问用户。
(2)在没有上述检查的情况下直接引用“数据输入2”表:如果当前文件中实际存在该名称的表单。
所以,不要忘记进行适当的调整以满足您的需求。
如果此解决方案适合您或者您还有其他问题,请与我们联系。