Найдите конкретное слово в столбце и скопируйте соседнее значение в другой столбец - PullRequest
0 голосов
/ 26 июня 2019

Мне нужна помощь в Excel VBA

enter image description here

Мне нужно найти текст (заголовок - например, Аккаунт). Ячейка со словом «Аккаунт» всегда будет в столбце C и скопировать значение из соседнего столбца C и вставить их на том же листе в столбец A до значения, представленного в столбце C (например, - 09: 00-09: 30 до его окончания)

Колонка A B C

    Account Test1
    Group   XXX
    Date    Mon24 Jun, 2019

    09:00-09:30 
    09:30-10:00 
    10:00-10:30 
    10:30-11:00 
    11:00-11:30 
    11:30-12:00 
    12:00-12:30 
    12:30-13:00 
    13:00-13:30 
    17:30-18:00 


    Account Test2
    Group   YYY
    Date    Mon24 Jun, 2019

    09:00-09:30 
    09:30-10:00 
    10:00-10:30 
    10:30-11:00 
    11:00-11:30 
    11:30-12:00 
    12:00-12:30 
    12:30-13:00 
    13:00-13:30 
    17:30-18:00 

Ответы [ 2 ]

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

@ AsUsual

Я нашел способ ->

Sub Copy()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet


Set Source = ActiveWorkbook.Worksheets("Input")
Set Target = ActiveWorkbook.Worksheets("Output")

j = 1
For Each c In Source.Range("C1:C4000")
    If IsNumeric(Left(c.Value, 1)) Then
       Source.Rows(c.Row).Copy Target.Rows(j)
       j = j + 1
    End If
Next c

End Sub

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

Попробуйте это ..

Sub ApplyHeader()
    Dim c As Range, Acc$, Grp$

    'Loops through first to last used i column C
    For Each c In Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp))

        'Stores value from adjacent cell if it says "Account".
        If c.Value = "Account" Then Acc = c.Offset(, 1).Value

        'Stores value from adjacent cell if it says "Group".
        If c.Value = "Group" Then Grp = c.Offset(, 1).Value

        'Applies stored values in columns to the left if first character is numerical.
        If IsNumeric(Left(c.Value, 1)) Then
            c.Offset(, -2).Value = Acc
            c.Offset(, -1).Value = Grp
        End If
    Next c

    'Removes stored values from "memory".
    Acc = "": Grp = ""
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...