Question

我的excel VBA代码有问题。在我的带有X表的工作簿中，一张全部是模板（示例Sheet1）。

应该在此模板中插入来自其他列（Sheets2,3,4）的不同列（示例C-J）中的单元格内容。在我这样做之前，我想选择（InputBox）它应该是什么（Sheet 2或3在Sheet Name上）。

在我的代码中，这行：设置ws1 =工作表（“Tour 83 Frankfurt”）。 sheet2,3,4 ..的名称并不总是相同。要将受欢迎的Worsheet示例:(“Tour 12 Berlin”）绑定到变量（ws1），我会搜索一种方法。 thanx for help andrews

代码：

Dim f As Range
Dim cell As Range
Dim rngWert As Range
Dim currentTarget As Range
Dim rngContent As Range
Dim strSearch As String
Dim strFind As String
Dim strChange As String

strSearch = InputBox("Please Search insert:", "Search") ????
If strSearch <> "" Then ????

Set ws1 = Worksheets("Tour 83 Frankfurt") !!!!!!!
Set ws2 = Worksheets("Sheets1")

For Each cell In ws2.Range("A2", ws2.cells(2, Columns.count).End(xlToLeft))
    ' Für jede Überschrift im Bereich der Überschriften in Tabelle1
    With ws1.Range("A2", ws1.cells(2, Columns.count).End(xlToRight))
        'Suche die aktuelle Überschrift in Tabelle2 im Bereich von Tabelle1
        Set f = .Find(cell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        'Nur wenn die Überschrift gefunden wurde ...
        If Not f Is Nothing Then
            Set rngContent = ws1.Range(f.Offset(1, 0), ws1.cells(Rows.count, f.Column).End(xlUp))
            For Each rngWert In rngContent
                Set currentTarget = cell.Offset(1, 0)
                While currentTarget.Value <> ""
                    Set currentTarget = currentTarget.Offset(1, 0)
                Wend
                currentTarget.Value = rngWert.Value
            Next
        End If
    End With
Next
MsgBox "insert OK"
'Set ws1 = Nothing
'Set ws2 = Nothing
End Sub

Answer 1

正如所说，在Inputbox之后：

On Error Resume Next
Set ws1 = Worksheets(strSearch)
If Err<>0 Then MsgBox "Enter correct sheet name": Exit Sub
On Error Goto 0

在VBA过程中使用Inputbox查找和更改String

1 个答案: