Vba объединить несколько столбцов до пустого - PullRequest
1 голос
/ 14 июня 2019

Я пытаюсь создать макрос для конкатенации нескольких столбцов, пока не найду пустую ячейку, когда он найдет, должен ли конкатенированный текст поместить в первую ячейку. Изображение показывает, как оно должно работать.В этом примере у меня есть значения от B до M, но это может варьироваться.Спасибо за вашу помощь и время!

Ответы [ 2 ]

0 голосов
/ 14 июня 2019

Вот решение VBA.Я предполагал, что во втором столбце всегда будет значение.

Sub Concat()
Dim i As Integer, Sht As Worksheet, Str As String
i = 3
Set Sht = ThisWorkbook.Sheets(1) 'Change this to whatever sheet you're using
Str = Sht.Cells(1, 2).Value
Do Until Sht.Cells(1, i).Value = ""
    Str = Str & "-" & Sht.Cells(1, i).Value
    i = i + 1
Loop
Sht.Cells(1, 1).Value = Str
End Sub
0 голосов
/ 14 июня 2019

Попробуйте, см. Комментарии для более подробной информации:

Option Explicit

Sub concatenateValues()

Dim ws As Worksheet: Set ws = ActiveWorkbook.Sheets("Sheet Name") '
Dim lRow As Long: lRow = ws.Cells(Rows.Count, 2).End(xlUp).Row 'get last row at column B
Dim lCol As Long: lCol = ws.Cells(1, Column.Count).End(xlToLeft).Column 'get last column at row 1, assuming you have at least headers

Dim arrData As Variant: arrData = ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) 'declare and allocate your data to an array

Dim R As Long, C As Long

For R = LBound(arrData) + 1 To UBound(arrData) 'for each row in your data, start at row 2
    For C = LBound(arrData, 2) + 1 To UBound(arrData, 2) 'for each column in your data, start at column 2
        arrData(R, 1) = arrData(R, 1) & arrData(R, C) 'concatenate the values
    Next C
Next R

ws.Range(ws.Cells(1, 1), ws.Cells(lRow, lCol)) = arrData 'put the values back into the sheet

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...