1
我正在搜索关键字,然后将找到的关键字中的行内容复制到当前表单中。我然后首先尝试,以便从细胞d到单元Z的内容复制到然后进行下式:复制单元格,然后在原始单元格上应用公式
"=RIGHT(Z2,LEN(Z2)-FIND(""_"",Z2))"
我的代码在另一个分离Sub
作为
Range("D1:D" & LastRow).Copy Range("Z1:Z" & LastRow) Range("D2:D" & LastRow).Formula = "=RIGHT(Z2,LEN(Z2)-FIND(""_"",Z2))"
如何合并此公式,以便在Private Sub
中的每次写入时,D单元首先被复制到单元Z,然后将公式放入单元D?
下面是默认代码:
Sub SearchFolders()
'UpdatebySUPERtoolsforExcel2016
Dim xFso As Object
Dim xFld As Object
Dim xUpdate As Boolean
Dim xCount As Long
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a folder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
xStrSearch = "failed"
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xOut = wsReport
xRow = 1
With xOut
.Cells(xRow, 1) = "Workbook"
.Cells(xRow, 2) = "Worksheet"
.Cells(xRow, 8) = "Unit"
.Cells(xRow, 9) = "Status"
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xFld = xFso.GetFolder(xStrPath)
xStrFile = Dir(xStrPath & "\*.xlsx")
Do While xStrFile <> ""
Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
For Each xWk In xWb.Worksheets
Set xFound = xWk.UsedRange.Find(xStrSearch, LookIn:=xlValues)
If Not xFound Is Nothing Then
xStrAddress = xFound.Address
End If
Do
If xFound Is Nothing Then
Exit Do
Else
xCount = xCount + 1
xRow = xRow + 1
.Cells(xRow, 1) = xWb.Name
.Cells(xRow, 2) = xWk.Name
.Cells(xRow, 3) = xFound.Address
WriteDetails rCellwsReport, xFound
End If
Set xFound = xWk.Cells.FindNext(After:=xFound)
Loop While xStrAddress <> xFound.Address
Next
xWb.Close (False)
xStrFile = Dir
Loop
.Columns("A:I").EntireColumn.AutoFit
.Rows(xCount).EntireRow.AutoFit
End With
MsgBox xCount & "cells have been found", , "SUPERtools for Excel"
ExitHandler:
Set xOut = Nothing
Application.ScreenUpdating = xUpdate
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Sub
Private Sub WriteDetails(ByRef xReceiver As Range, ByRef xDonor As Range)
xReceiver.Value = xDonor.Parent.Name
xReceiver.Offset(, 1).Value = xDonor.Address
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copy the row of the Donor to the receiver starting from column D.
' Since you want to preserve formats, we use the .Copy method
xDonor.EntireRow.Resize(, 100).Copy xReceiver.Offset(, 2)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set xReceiver = xReceiver.Offset(1)
End Sub
感谢您的解决方案,我想在D单元格中输入公式'“= RIGHT(Z2,LEN(Z2)-FIND(”“_”“,Z2))”'...我做了以下操作:... .Formula =“= RIGHT (Z2,LEN(Z2) - 查找( “” _ “”,Z2))“'但是当公式不会随着单元格向下移动而变化,即在第46行上,公式应该变成:“.Formula =”= RIGHT(Z46,LEN(Z46)-FIND(“”_“”,Z46))“ '。你能告诉我如何得到这个输出吗?谢谢! – Joe
@Joe在代码中查看修改后的公式。 –
这有效......谢谢! – Joe