2015-10-08 2 views
1

У меня проблема с моим кодом в excel VBA. В моей книге с X-листами один лист всего шаблона (пример Sheet1).найти и изменить строку с полем ввода в процедуре VBA

Содержимое ячейки в разных столбцах (пример C-J) из других (Таблицы2,3,4) должно быть вставлено в этот шаблон. Прежде чем я это сделаю, я хочу выбрать (InputBox) то, что (sheet2 или 3 над именем листа) должно быть.

В моем коде это Line: Установить ws1 = Worksheets ("Tour 83 Frankfurt"). Название листов2,3,4 .. не всегда одинаково. Чтобы привязать предпочтительный пример Worsheet: («Tour 12 Berlin») к переменной (ws1), я ищу способ сделать это. спасибо за помощь 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 
+0

'Set WS1 = Worksheets (strSearch)' будет работать, если вы вводите правильный листовой имя , В этом случае вам нужно только добавить в конце инструкцию «End If», чтобы она работала. –

ответ

0

Как было сказано, после того, как InputBox:

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

много thanx Olle и Max ... быстро и красиво – andrewz

+0

@andrewz: Если это решило вашу проблему для этого вопроса, пожалуйста, примите ответ (нажмите на серый тик под заголовками вверх/вниз слева от сообщения, я становлюсь зеленым!), и вы также можете повысить! ;) – R3uK

Смежные вопросы