使用用户窗体中的数据将值从一个 sheet 复制到另一个
Copy values from one sheet to another using Data from UserForm
我有一个用户表单,其中包含您可以填写的以下值:
TextBoxLopnummer.Value
TextBoxFragestallare.Value
TextBoxMottagare.Value
TextBoxDatum.Value
图片:
当有人填写日期值时:TextBoxDatum.Value
我想在整个工作簿中搜索这个值并粘贴该单元格所在的整行,在 Sheet "Lägg in Ärende" 单元格 A15。请注意,此值可以在工作簿中的不同 sheet 中出现,并在同一 sheet 中出现多次。所以在单元格 A15 和下面可以有很多行。
我已经开始实施了一点,但老实说我不知道如何完成它:
'in the rows below I wanna write so that ".Value=copies the value from the sheets where it finds eg. the date".
emptyRow = WorksheetFunction.CountA(ws.Range("A:A")) + 14
Cells(emptyRow, 1).Value =
Cells(emptyRow, 2).Value =
Cells(emptyRow, 3).Value =
Cells(emptyRow, 4).Value =
Cells(emptyRow, 5).Value =
Cells(emptyRow, 6).Value =
Cells(emptyRow, 7).Value =
Cells(emptyRow, 8).Value =
请注意,您可以同时搜索多个日期,您可以根据 4 个条件进行搜索,请参见上图。当您填写 2 个条件时,代码应将这两个条件与整个工作簿中具有相同条件的行相匹配,然后复制该行等。
此外,TextBoxLopnummer 将始终位于单元格 A2 中,并向下位于单元格 B2 中的 sheets 中。TextBoxFragestallare 在单元格 B2 中,TextBoxMottagare 在单元格 C2 中,TextBoxDatum 在单元格 D2 中。
我怎样才能继续解决我的问题?
这将帮助您完成您正在尝试做的事情。根据您对原始问题的评论,我相信这就是您所需要的。
进程:
用户窗体代码上的搜索按钮有一个点击事件。在示例中,它是 Button1。根据自己的需要命名。
在每个 运行(每个请求)之前清除目标 sheet
从文本框值设置一个数组,其中每个值的索引与要搜索的列号匹配
遍历每个工作sheet,目标sheet除外。
一次一行,将相应列的值与匹配它的数组索引进行比较。
如果找到匹配项,"match" 变量设置为 true
遍历数组中其余的 TextBoxes 值,如果其中任何一个不匹配,"match" 变量设置为 false,并中断对 Textboxes 的循环作为一个失败。
如果 "match" 在搜索作品的行循环结束时为真 sheet,将循环遍历第 1 至 8 列,设置来自搜索 sheet 到目标 Sheet.
下一行完成循环
下一个工作sheet完成循环
可能要检查的问题:
您可能需要对日期进行一些转换,但如果 sheet 上的日期与用户表单上的日期格式相同,它应该可以工作。
如果 sheet 中的文本具有 0.0 或不同的小数位,数字可能会出现类似的问题。
如果出现任何此类问题,只需使用您的 Locals Window 并单步执行您的代码以查看它的执行情况。您收到的类似错误可能是类型不匹配。通过使用 Locals window 进行调试,您将知道需要格式化哪些特定值以便将它们与文本框进行比较。步进太长打个断点
未测试:有问题请评论。
Private Sub button1_click()
Dim ws As Worksheet
Dim lastRow As Long, lRow As Long, tRow As Long
Dim tempValue As String
Dim targetSheet As String
Dim tempList(1 To 4) As String
Dim i As Long
Dim match As Boolean
match = False
'Set TargetSheet and clear the previous contents
targetSheet = "Lägg in Ärende"
tRow = 15
lastRow = Sheets(targetSheet).Range("A" & Rows.count).End(xlUp).row
Sheets(targetSheet).Range("A15:H" & lastRow).ClearContents
'Set an array of strings, based on the index matching the column to search for each
tempList(1) = TextBoxLopnummer.Text 'Column "A" (1)
tempList(2) = TextBoxFragestallare.Text 'Column "B" (2)
tempList(3) = TextBoxMottagare.Text 'Column "C" (3)
tempList(4) = TextBoxDatum.Text 'Column "D" (4)
'Search through each worksheet
For Each ws In Worksheets
If ws.name <> targetSheet Then
'Get last row of sheet
lastRow = ws.Range("A" & Rows.count).End(xlUp).row
'Search through the sheet
For lRow = 2 To lastRow
'Using the array of values from the TextBoxes,
'Each column number matches the index of the array.
'Only testing the array values that have text in them,
'If any don't match the loop is broken and returns to main search.
For i = 1 To 4
If tempList(i) <> "" Then
If ws.Cells(lRow, i).Text = tempList(i) Then
match = True
Else
match = False
Exit For 'If any of the values is false, exit i loop
End If
End If
Next i
'If there was a match, copy the data from Searched ws to targetSheet
If match = True Then
'Get the first Empty row on target sheet
For lCol = 1 To 8
Sheets(targetSheet).Cells(tRow, lCol).Value = ws.Cells(lRow, lCol).Value
Next lCol
tRow = tRow + 1
End If
Next lRow
End If
Next ws
End Sub
我有一个用户表单,其中包含您可以填写的以下值:
TextBoxLopnummer.Value
TextBoxFragestallare.Value
TextBoxMottagare.Value
TextBoxDatum.Value
图片:
当有人填写日期值时:TextBoxDatum.Value
我想在整个工作簿中搜索这个值并粘贴该单元格所在的整行,在 Sheet "Lägg in Ärende" 单元格 A15。请注意,此值可以在工作簿中的不同 sheet 中出现,并在同一 sheet 中出现多次。所以在单元格 A15 和下面可以有很多行。
我已经开始实施了一点,但老实说我不知道如何完成它:
'in the rows below I wanna write so that ".Value=copies the value from the sheets where it finds eg. the date".
emptyRow = WorksheetFunction.CountA(ws.Range("A:A")) + 14
Cells(emptyRow, 1).Value =
Cells(emptyRow, 2).Value =
Cells(emptyRow, 3).Value =
Cells(emptyRow, 4).Value =
Cells(emptyRow, 5).Value =
Cells(emptyRow, 6).Value =
Cells(emptyRow, 7).Value =
Cells(emptyRow, 8).Value =
请注意,您可以同时搜索多个日期,您可以根据 4 个条件进行搜索,请参见上图。当您填写 2 个条件时,代码应将这两个条件与整个工作簿中具有相同条件的行相匹配,然后复制该行等。
此外,TextBoxLopnummer 将始终位于单元格 A2 中,并向下位于单元格 B2 中的 sheets 中。TextBoxFragestallare 在单元格 B2 中,TextBoxMottagare 在单元格 C2 中,TextBoxDatum 在单元格 D2 中。
我怎样才能继续解决我的问题?
这将帮助您完成您正在尝试做的事情。根据您对原始问题的评论,我相信这就是您所需要的。
进程:
用户窗体代码上的搜索按钮有一个点击事件。在示例中,它是 Button1。根据自己的需要命名。
在每个 运行(每个请求)之前清除目标 sheet
从文本框值设置一个数组,其中每个值的索引与要搜索的列号匹配
遍历每个工作sheet,目标sheet除外。
一次一行,将相应列的值与匹配它的数组索引进行比较。
如果找到匹配项,"match" 变量设置为 true
遍历数组中其余的 TextBoxes 值,如果其中任何一个不匹配,"match" 变量设置为 false,并中断对 Textboxes 的循环作为一个失败。
如果 "match" 在搜索作品的行循环结束时为真 sheet,将循环遍历第 1 至 8 列,设置来自搜索 sheet 到目标 Sheet.
下一行完成循环
下一个工作sheet完成循环
可能要检查的问题:
您可能需要对日期进行一些转换,但如果 sheet 上的日期与用户表单上的日期格式相同,它应该可以工作。
如果 sheet 中的文本具有 0.0 或不同的小数位,数字可能会出现类似的问题。
如果出现任何此类问题,只需使用您的 Locals Window 并单步执行您的代码以查看它的执行情况。您收到的类似错误可能是类型不匹配。通过使用 Locals window 进行调试,您将知道需要格式化哪些特定值以便将它们与文本框进行比较。步进太长打个断点
未测试:有问题请评论。
Private Sub button1_click()
Dim ws As Worksheet
Dim lastRow As Long, lRow As Long, tRow As Long
Dim tempValue As String
Dim targetSheet As String
Dim tempList(1 To 4) As String
Dim i As Long
Dim match As Boolean
match = False
'Set TargetSheet and clear the previous contents
targetSheet = "Lägg in Ärende"
tRow = 15
lastRow = Sheets(targetSheet).Range("A" & Rows.count).End(xlUp).row
Sheets(targetSheet).Range("A15:H" & lastRow).ClearContents
'Set an array of strings, based on the index matching the column to search for each
tempList(1) = TextBoxLopnummer.Text 'Column "A" (1)
tempList(2) = TextBoxFragestallare.Text 'Column "B" (2)
tempList(3) = TextBoxMottagare.Text 'Column "C" (3)
tempList(4) = TextBoxDatum.Text 'Column "D" (4)
'Search through each worksheet
For Each ws In Worksheets
If ws.name <> targetSheet Then
'Get last row of sheet
lastRow = ws.Range("A" & Rows.count).End(xlUp).row
'Search through the sheet
For lRow = 2 To lastRow
'Using the array of values from the TextBoxes,
'Each column number matches the index of the array.
'Only testing the array values that have text in them,
'If any don't match the loop is broken and returns to main search.
For i = 1 To 4
If tempList(i) <> "" Then
If ws.Cells(lRow, i).Text = tempList(i) Then
match = True
Else
match = False
Exit For 'If any of the values is false, exit i loop
End If
End If
Next i
'If there was a match, copy the data from Searched ws to targetSheet
If match = True Then
'Get the first Empty row on target sheet
For lCol = 1 To 8
Sheets(targetSheet).Cells(tRow, lCol).Value = ws.Cells(lRow, lCol).Value
Next lCol
tRow = tRow + 1
End If
Next lRow
End If
Next ws
End Sub