Ограничение диапазона VBA

Question

У меня есть этот код, который объединяет диапазон ячеек в одну ячейку через запятую. Например, A1:1, A2:2, A3:3, A4:4, тогда они будут похожи на (1,2,3,4) в A5. Этот код работает на всем листе. Мне нужна помощь, чтобы иметь возможность настроить его диапазон в коде. Я могу изменить значение строки и начало столбца для результатов, как вы можете видеть в коде. Благодарю.

Проблема, которую я имею с этим VBA, скажем, если данные находятся в A:F, а выходные ячейки в K:M, он удаляет другие нерелевантные данные, присутствующие в ячейках после столбца M.

Sub GetValues()
  Dim R As Long, C As Long, V As Variant, Txt As String
  For C = 11 To Cells(1, Columns.Count).End(xlToLeft).Column
    For R = 5 To Cells(Rows.Count, "A").End(xlUp).Row
      Txt = ""
      For Each V In Split(Cells(1, C).Value, ",")
        If Not Intersect(Rows(R), Columns("A:F")).Find(V, , , xlWhole, , , False, False) Is Nothing Then Txt = Txt & "," & V
      Next
      Cells(R, C).Value = Mid(Txt, 2)
    Next
  Next
End Sub

Answer 1

Это выражение: Cells(1, Columns.Count).End(xlToLeft).Column выводит цикл столбца до последней записи в первой строке, так же как это выражение: Cells(Rows.Count, "A").End(xlUp).Row выводит цикл до последней строки в первом столбце.

Кажется, что эта процедура просто берет любой список в первой строке каждого столбца в диапазоне и проверяет, существует ли каждый элемент в первых 6 записях соответствующей строки, и копирует те элементы, которые делают - что не совсем точно что ты описал Если совпадений не найдено, да, ячейка устанавливается пустой.

Intersect(Rows(R), Columns("A:F")) , по моему мнению, было бы более четко и экономически выражено, так как ведущая ячейка была изменена до правильных столбцов: Cells(R,1).Resize(1,6)

Answer 2

Я получил альтернативный ответ на Vbaexpress.com, вот он:

от AD1 или отрегулируйте эту строку для поиска слева от AD1, в этом примере измененного на S

For C = 11 To Cells(1, "S").End(xlToLeft).Column 

Кстати, если у вас есть такие проблемы, попробуйте что-то вроде ниже, чтобы отследить проблему

Cells(R, C).select 
 ' or
Cells(R, C).interior.colorindex = 6 
Cells(R, C).Value = Mid(Txt, 2)