Здравствуйте! Есть такой вопрос подскажите как решить? Не знаю правда как объяснить. Есть два столбца дом и квартира как объединить их в один столбец, но так, чтобы значения не объединять и расположить последовательно. В приложенном файле я обрисовал проблему более понятно!
Здравствуйте! Есть такой вопрос подскажите как решить? Не знаю правда как объяснить. Есть два столбца дом и квартира как объединить их в один столбец, но так, чтобы значения не объединять и расположить последовательно. В приложенном файле я обрисовал проблему более понятно!makc1985
Dim X As Long 'To roll basic table Dim Y As Long 'To roll result table Dim A As Long 'To remember the header Dim B As Long 'To measure the size of basic table
Application.ScreenUpdating = False With ThisWorkbook.Worksheets("Data")
B = .Cells(Rows.Count, 1).End(xlUp).Row If B < 2 Then Exit Sub
.Cells(2, 4).Value = .Cells(2, 1).Value .Cells(3, 4).Value = .Cells(2, 2).Value A = 2: Y = 4
For X = 3 To B If .Cells(X, 1).Value = .Cells(A, 1).Value Then .Cells(Y, 4).Value = .Cells(X, 2).Value Y = Y + 1 Else .Cells(Y, 4).Value = .Cells(X, 1).Value: Y = Y + 1 .Cells(Y, 4).Value = .Cells(X, 2).Value: Y = Y + 1 A = X End If Next X
End With Application.ScreenUpdating = True End Sub
[/vba]
makc1985, здравствуйте.
Решение макросом, по нажатию на кнопку.
[vba]
Код
Sub Rio_Cooking()
Dim X As Long 'To roll basic table Dim Y As Long 'To roll result table Dim A As Long 'To remember the header Dim B As Long 'To measure the size of basic table
Application.ScreenUpdating = False With ThisWorkbook.Worksheets("Data")
B = .Cells(Rows.Count, 1).End(xlUp).Row If B < 2 Then Exit Sub
.Cells(2, 4).Value = .Cells(2, 1).Value .Cells(3, 4).Value = .Cells(2, 2).Value A = 2: Y = 4
For X = 3 To B If .Cells(X, 1).Value = .Cells(A, 1).Value Then .Cells(Y, 4).Value = .Cells(X, 2).Value Y = Y + 1 Else .Cells(Y, 4).Value = .Cells(X, 1).Value: Y = Y + 1 .Cells(Y, 4).Value = .Cells(X, 2).Value: Y = Y + 1 A = X End If Next X
End With Application.ScreenUpdating = True End Sub