我是StackOverflow的新手，但是已经有一段时间处理这个问题了，而且我很困难。现在，我的代码需要＆＃39; Name＆＃39;从文本框输入，如果列A中的数据与输入的名称匹配，则从该表中的整行复制数据，将其复制到另一个工作表，然后从原始工作表中删除数据，并告诉用户如何很多行被移动了。此代码如下所示：
我有两个问题。一，我需要一个错误检查，如果输入文本框的名称不存在，它会显示一个带有该消息的消息框，两个，我需要允许此代码执行它所做的事情，但是从单独的工作簿。如同，从一个工作簿中的工作表中复制数据，并将其移动到另一个工作簿中的工作表。我的代码现在只能在同一个工作簿中使用。
感谢任何和所有帮助。提前谢谢。
DatabaseReference ref = database.getReference("tokens");
Map<String, String> users = new HashMap<>();
users.put(userUID, token);
ref.setValueAsync(users);
答案 0 :(得分：0)
要回答有关检查工作簿中是否存在工作表的第一个问题，您可以使用如下函数：
Public Function U_W_DoesWorksheetExist(ByVal sheetname As String, aWorkbook As Workbook) As Boolean
On Error Resume Next
U_W_DoesWorksheetExist = (Not aWorkbook.Sheets(sheetname) Is Nothing)
On Error GoTo 0
End Function
现在，当您引用目标时，您只是说工作表（“已取消的服务”），并且宏将假定ActiveWorkook作为主要工作簿来复制工作表。您需要引用要粘贴的工作簿所在的工作簿。看看下面的代码是否适合您，并查看我在其上添加的评论：
Private Sub buttonDelete_Click()
'When the Delete button is clicked, the following function is ran to copy the row from Current Services, move it to Cancelled Services
'and then delete the row from Current Services.
Dim wkBk1 As Workbook
Dim wkBk2 As Workbook
Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
Dim count As Long
Dim arrFromWorkbookPath(1 To 4) As String
Dim c As Long
' If you need more than 4 rearrange the Array to as many as you need.
arrFromWorkbookPath(1) = "C:\Users\Nathan\Desktop\Sandbox\FromWB1.xlsm"
arrFromWorkbookPath(4) = "C:\Users\Nathan\Desktop\Sandbox\FromWB2.xlsm"
arrFromWorkbookPath(3) = "C:\Users\Nathan\Desktop\Sandbox\FromWB3.xlsm"
arrFromWorkbookPath(4) = "C:\Users\Nathan\Desktop\Sandbox\FromWB4.xlsm"
' The Workbook were you will be pasting the sheets.
Set wkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro2.xlsm")
For c = LBound(arrFromWorkbookPath) To UBound(arrFromWorkbookPath)
On Error Resume Next
' Open the Workbook from where the sheet will be copied from.
Set wkBk1 = Workbooks.Open(arrFromWorkbookPath(c))
If Err.Number = 1004 Then
MsgBox "File Does Not Exist"
Exit Sub
End If
' USE PROCEDURE LIKE THIS TO CHECK "Current Customers" in wkBk1 and Cancelled Services in wkBk2.
If U_W_DoesWorksheetExist("Current Customers", wkBk1) And U_W_DoesWorksheetExist("Cancelled Services", wkBk1) Then
i = wkBk1.Worksheets("Current Customers").UsedRange.Rows.count
J = wkBk2.Worksheets("Cancelled Services").UsedRange.Rows.count
count = 0
If J = 1 Then
If Application.WorksheetFunction.CountA(wkBk2.Worksheets("Cancelled Services").UsedRange) = 0 Then J = 0
End If
Set xRg = wkBk1.Worksheets("Current Customers").Range("A1:A" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.count
If CStr(xRg(K).Value) = Me.fName.Value Then
count = count + 1
' Here you need to specify the workbook, not just the sheet wkBk2.Worksheets("Cancelled Services").
xRg(K).EntireRow.Copy Destination:=wkBk2.Worksheets("Cancelled Services").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = Me.fName.Value Then
K = K - 1
End If
J = J + 1
End If
Next
wkBk1.Close False
Else
' Display error if the sheet doesn't exist.
MsgBox "Sheets Current Customers or Cancelled Services don't exists."
End If
Next c
Application.ScreenUpdating = True
End Sub
答案 1 :(得分：0)
你的代码中发生了很多奇怪的事情，所以我试图对它进行一些清理并留下一些评论，说明为什么你不应该在那里有一些东西。我已经解决了问题的第一部分，但为了在工作簿之间移动行，您需要确定要移动的数据和位置，尤其是使用Workbook完全限定范围，或者在您的情况下，wkBk1和wkBk2
Private Sub buttonDelete_Click()
'When the Delete button is clicked, the following function is ran to copy the row from Current Services, move it to Cancelled Services
'and then delete the row from Current Services.
Dim wkBk1 As Workbook, wkBk2 As Workbook
Dim xRg As Range, xCell As Range
Dim I As Long, J As Long, K As Long, count As Long
Dim MyName As String
'Assign our name value here
MyName = Me.fName.Value
'Let's use an error handler instead - this way our Err.Number will actually be triggered
On Error GoTo Handler
Set wkBk1 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro.xlsm")
Set wkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Sandbox\testMacro2.xlsm")
On Error GoTo 0
I = wkBk1.Worksheets("Current Customers").UsedRange.Rows.count
J = Worksheets("Cancelled Services").UsedRange.Rows.count 'Need to add either wkBk1 or wkBk2 to the front of this
'We don't really NEED this, as count is initialized as 0 anyways
'count = 0
If J = 1 Then
'What is the purpose of this? Can it ever even return true if J = 1?
If Application.WorksheetFunction.CountA(Worksheets("Cancelled Services").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Current Customers").Range("A1:A" & I) 'Need to add either wkBk1 or wkBk2 to the front of this
'Here we check the range for the name. If it's not there, we throw a messsage box and exit the sub
If Not WorksheetFunction.CountIf(xRg, MyName) > 0 Then
MsgBox "Name doesn't exist in the range"
Exit Sub
End If
'Got rid of On Error Resume Next, we don't need it and it's sloppy coding
Application.ScreenUpdating = False
'This whole snippet needs to be changed
'Also since you're deleting rows, you need to step BACKWARDS through this loop
For K = 1 To xRg.count
If CStr(xRg(K).Value) = MyName Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Cancelled Services").Range("A" & J + 1)
xRg(K).EntireRow.Delete
'Why do we have this? We already know this is true?
'If CStr(xRg(K).Value) = MyName Then
K = K - 1
'End If
'Move count to AFTER we've actually moved the row, with On Error Resume Next your count could've gone up without a row being moved...
count = count + 1
J = J + 1
End If
Next
Application.ScreenUpdating = True
MsgBox count & " rows moved"
Handler:
If Err.Number = 1004 Then
MsgBox "File Does Not Exist"
End If
End Sub
答案 2 :(得分：0)
此代码使用FIND而不是查看每一行。它会创建一系列所有找到的行，然后在删除原始值之前将整个批次复制到一个匹配中。在结束之前它告诉你它发现了多少。
这假设您在Userform上有一个名为fname的文本框和名为buttonDelete的按钮。
Private Sub buttonDelete_Click()
Dim wrkBk1 As Workbook
Dim wrkBk2 As Workbook
Dim sPath As String
Dim wrkSht1 As Worksheet
Dim wrkSht2 As Worksheet
Dim rLastCell_Cur As Range
Dim rLastCell_Can As Range
Dim sNameToSearch As String
Dim rSearchRange As Range
Dim rFound As Range
Dim sFirstAddress As String
Dim lFoundCount As Long
Dim rFoundUnion As Range
sPath = "C:\Users\Nathan\Desktop\Sandbox\"
If Not (FileExists(sPath & "testMacro.xlsm") And FileExists(sPath & "testMacro2.xlsm")) Then
'One of the files doesn't exist so display message and exit.
MsgBox "One of the files does not exist.", vbOKOnly + vbCritical
Else
Set wrkBk1 = Workbooks.Open(sPath & "testMacro.xlsm")
Set wrkBk2 = Workbooks.Open(sPath & "testMacro2.xlsm")
If Not (WorkSheetExists("Current Customers", wrkBk1) And _
WorkSheetExists("Cancelled Services", wrkBk2)) Then
'One of the sheets doesn't exist so display message and exit.
MsgBox "One of the required sheets doesn't exist.", vbOKOnly + vbCritical
Else
'Find the limits of the two sheets.
Set wrkSht1 = wrkBk1.Worksheets("Current Customers")
Set rLastCell_Cur = LastCell(wrkSht1)
Set wrkSht2 = wrkBk2.Worksheets("Cancelled Services")
Set rLastCell_Can = LastCell(wrkSht2).Offset(1) 'We want the cell below the last cell here.
'Grab what we're searching for and where we're searching for it.
sNameToSearch = Me.fName
With wrkSht1
Set rSearchRange = .Range(.Cells(1, 1), .Cells(rLastCell_Cur.Row, 1))
End With
With rSearchRange
'Perform first search.
Set rFound = .Find(What:=sNameToSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'If something was found then we're good to go.
If Not rFound Is Nothing Then
sFirstAddress = rFound.Address
Do
lFoundCount = lFoundCount + 1
'Create a union of ranges to copy over.
If rFoundUnion Is Nothing Then
Set rFoundUnion = rFound.EntireRow
Else
Set rFoundUnion = Union(rFoundUnion, rFound.EntireRow)
End If
'Look for the next item.
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFirstAddress
'All instances have been found so copy it all over and then delete the original.
rFoundUnion.Copy wrkSht2.Cells(rLastCell_Can.Row, 1)
rFoundUnion.Delete Shift:=xlUp
End If
MsgBox "Found " & lFoundCount & " occurrences of " & sNameToSearch, vbOKOnly + vbInformation
End With
End If
End If
End Sub
Public Function FileExists(FilePath As String) As Boolean
FileExists = Dir(FilePath) <> ""
End Function
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range
Dim lLastCol As Long, lLastRow As Long
On Error Resume Next
With wrkSht
If Col = 0 Then
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
Else
lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
End If
If lLastCol = 0 Then lLastCol = 1
If lLastRow = 0 Then lLastRow = 1
Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
End With
On Error GoTo 0
End Function
对buttonDelete_Click()过程的此更新将打开特定文件夹中的所有Excel文件，并将找到的名称复制到该文件夹中不存在的另一个文件中。
Private Sub buttonDelete_Click()
Dim colFiles As Collection
Dim vFile As Variant
Dim sTemp As String
Dim wrkBk1 As Workbook
Dim wrkBk2 As Workbook
Dim sPath As String
Dim wrkSht1 As Worksheet
Dim wrkSht2 As Worksheet
Dim rLastCell_Cur As Range
Dim rLastCell_Can As Range
Dim sNameToSearch As String
Dim rSearchRange As Range
Dim rFound As Range
Dim sFirstAddress As String
Dim lFoundCount As Long
Dim rFoundUnion As Range
sPath = "C:\Users\Nathan\Desktop\Sandbox\"
'Put the full path of each Excel file in to a collection.
'These contain the "Current Customers" sheet.
Set colFiles = New Collection
sTemp = Dir$(sPath & "*.xls*")
Do While Len(sTemp) > 0
colFiles.Add sPath & sTemp
sTemp = Dir$
Loop
If Not (FileExists("C:\Users\Nathan\Desktop\Cancelled.xlsx")) Then
'Cancelled Services book doesn't exist.
MsgBox "Cancelled Services doesn't exist.", vbOKOnly + vbCritical
Else
'Open Cancelled Services before working through the collection of Current Customers.
Set wrkBk2 = Workbooks.Open("C:\Users\Nathan\Desktop\Cancelled.xlsx")
Set wrkSht2 = wrkBk2.Worksheets("Cancelled Services")
For Each vFile In colFiles
Set wrkBk1 = Workbooks.Open(vFile)
'The file will only be processed if it contains "Current Customers" sheet.
If WorkSheetExists("Current Customers", wrkBk1) Then
Set wrkSht1 = wrkBk1.Worksheets("Current Customers")
Set rLastCell_Can = LastCell(wrkSht2).Offset(1)
Set rLastCell_Cur = LastCell(wrkSht1)
'Grab what we're searching for and where we're searching for it.
sNameToSearch = Me.fName
With wrkSht1
Set rSearchRange = .Range(.Cells(1, 1), .Cells(rLastCell_Cur.Row, 1))
End With
With rSearchRange
'Perform first search.
Set rFound = .Find(What:=sNameToSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
'If something was found then we're good to go.
If Not rFound Is Nothing Then
sFirstAddress = rFound.Address
Do
lFoundCount = lFoundCount + 1
'Create a union of ranges to copy over.
If rFoundUnion Is Nothing Then
Set rFoundUnion = rFound.EntireRow
Else
Set rFoundUnion = Union(rFoundUnion, rFound.EntireRow)
End If
'Look for the next item.
Set rFound = .FindNext(rFound)
Loop While rFound.Address <> sFirstAddress
'All instances have been found so copy it all over and then delete the original.
rFoundUnion.Copy wrkSht2.Cells(rLastCell_Can.Row, 1)
rFoundUnion.Delete Shift:=xlUp
End If
End With
End If
Set rFound = Nothing
Set rFoundUnion = Nothing
sFirstAddress = ""
wrkBk1.Close SaveChanges:=True
Next vFile
MsgBox "Found " & lFoundCount & " occurrences of " & sNameToSearch, vbOKOnly + vbInformation
End If
End Sub