Как поменять значения в ячейках - PullRequest
0 голосов
/ 21 октября 2018

Итак, я пытаюсь поменять значения в ячейках рядом друг с другом, начиная с ячейки G2, и продолжаю делать это по мере движения вправо, пока в строке не будет найдена пустая ячейка.Затем переместитесь вниз на один ряд и сделайте то же самое, двигаясь вправо, пока не найдутся пустые клетки.Затем двигайтесь вниз и так далее и тому подобное.Хитрость заключается в том, что столбцы сильно различаются, от 20 до более 3000. Все начинается в ячейке G2, и в этом случае оно уменьшается до G100, но это может измениться в любое время.Пока что я могу найти самый правый столбец и установить диапазон цикла, но сам цикл отключен, так что это работает неправильно.Есть мысли, эксперты?

Here is the code sample that I am testing.

Dim LastColumn As Long
With ActiveSheet.UsedRange
    LastColumn = .Columns(.Columns.Count).Column
End With

Dim ColumnNumber As Long
Dim ColumnLetter As String
ColumnLetter = Split(Cells(1, LastColumn).Address, "$")(1)

    Columns("G:" & ColumnLetter).Select
    Selection.Replace What:="name: ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="- data_type: ", Replacement:="", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

' start to swap cell contents...
Dim r As Range
Dim c As Range
Dim sht As Worksheet
Dim LastRow As Long
Dim temp As Double

Set sht = ActiveSheet
LastRow = sht.Cells(sht.Rows.Count, "G").End(xlUp).Row

Set r = Range("G2:" & ColumnLetter & LastRow)

For Each c In r
    c.Select
    temp = ActiveCell.Value
    ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value & ":" & temp
    ActiveCell.Offset(0, 2).Select
Next

1 Ответ

0 голосов
/ 21 октября 2018

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

Option Explicit

Sub consolidate()
    Dim r As Long, c As Long, d As Long

    With Worksheets(ActiveSheet.Name)
        For r = 2 To .Cells(.Rows.Count, "G").End(xlUp).Row
            d = 7
            For c = 7 To .Cells(r, .Columns.Count).End(xlToLeft).Column Step 2
                .Cells(r, d) = Join(Array(.Cells(r, c).Value, _
                                          .Cells(r, c + 1).Value), Chr(32))
                 d = d + 1
            Next c
            .Range(.Cells(r, d), .Cells(r, .Columns.Count).End(xlToLeft)).Clear
        Next r
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...