Использование значения ячейки для указания места вставки в Excel VBA

Question

У меня есть таблица с двумя строками: первая строка содержит места, где должно быть вставлено значение второй строки.

Например:

row 1 : sheet8!D2 sheet6!D2 sheet2!C5 
row 2 : apple  lemon  pEER 

Так яблока должен быть вставлен в лист 8 клеток D8. Лимон должен быть вставлен в ячейку D6 листа6. Проблема в том, что значение apple приклеивается повсюду (в sheet8!D2, sheet6!D2 и sheet2!C5). Как я могу это исправить?

Sub Sample() 
Dim rng As Range 
Dim Sh As String, Cl As String 
Dim ws As Worksheet 
Dim i As Integer 
Dim Row1 As String 

ncol = Range("A1:F1").Columns.Count 

For i = 1 To ncol 


Row1 = Range("A1:F1").Cells(1, i).Value 

Set ws = ThisWorkbook.Sheets("Sheet2") 

With ws 
    Sh = Split(Row1, "!")(0) 
    Cl = Split(Row1, "!")(1) 

    Set rng = ThisWorkbook.Sheets(Sh).Range(Cl) 

    rng.Value = .Range("A2").Value 

End With 

Next i 

End Sub 

Answer 1

С кодом возникает несколько проблем. Прежде всего, перейдите к его правильной практике, чтобы поставить Option Explicit в верхней части каждого модуля, это обеспечит определение переменных (ncol не определено).

Следующий код исправит проблему, хотя ее можно настроить различными способами. Основная проблема заключается в том, что вы неправильно настроили диапазоны ссылок, вы перемещаетесь по столбцам с помощью своего цикла, но всегда возвращаетесь к ячейке A2. Предполагая, что ваши входные данные находятся в строках 1 и 2 и запускаются с листа с этими данными, это будет работать.

Sub SampleFixed() 
    Dim rng As Range 
    Dim Sh As String, Cl As String 
    Dim ws As Worksheet 
    Dim i As Integer, ncol As Integer 
    Dim Row1 As String 

    ncol = Range("A1:F1").Columns.Count 

    For i = 1 To ncol 
     Set ws = ActiveSheet 

     With ws 
      Row1 = .Cells(1, i).Value 

      If Len(Row1) > 0 Then 
       Sh = Split(Row1, "!")(0) 
       Cl = Split(Row1, "!")(1) 
       Set rng = ThisWorkbook.Sheets(Sh).Range(Cl) 

       'Here you were always refering to cell A2 not moving through the values which was the main problem. 
       rng.Value = .Cells(2, i).Value  
      End If 
     End With 
    Next i 
End Sub