如果F列包含特定文本,则从C列中提取值

时间:2018-12-24 23:09:36

标签: excel vba excel-vba excel-formula

因此,如果列包含特定单词,我想从一行中提取数据。因此,如果F列包含单词“ FITNESS”,我希望将相应行的名称,数字,开始和结束时间复制到另一个选项卡上。

Roster-“名册”标签

enter image description here

Headcount-“ HEADCOUNT”标签

enter image description here

所以基本上我想将每个人的电话号码,姓名,开始和结束时间提取到“人数”标签的正确部分。因此,在A3中,我将以Ila Yokum结束,并以O3作为她的电话号码,以P3作为开始时间,以Q3作为结束时间。在A4的Cherrie Errico和O4的号码。在A10中,我会遇到卡洛斯·比格姆(Carlos Bigham)。等等

我尝试了以下操作,但不能正确复制所有内容。

=if(ROSTER!A:A="ACCESSOIRES";ROSTER!B2;"")

Works for A3-A5 but not for A10?

名册每天都会变化,每个部分的人数或多或少都可能在名册中,以及不同的开始/结束时间。但是,部分和号码始终与该人链接。

感谢您的帮助,

1 个答案:

答案 0 :(得分:0)

您可以尝试:

Option Explicit

Sub test()

    Dim i As Long
    Dim LastRowSR As Long, LastRowSH1 As Long
    Dim strSection As String, strNumber As String, strStart As String, strEnd As String, strName As String

    'Sort Table in Roster Sheet
    With ThisWorkbook.Worksheets("ROSTER")
        .Sort.SortFields.Clear
        .Sort.SortFields.Add2 Key:=Range("F1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        LastRowSR = .Cells(.Rows.Count, "A").End(xlUp).Row

        With .Sort
            .SetRange Range("A2:F" & LastRowSR)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With

    'Headers Formating
    With ThisWorkbook.Worksheets("HEADCOUNT")
        .Cells.Clear

        With .Range("A1")
            .Value = "Headcount"
            .Font.Bold = True
            .Font.Color = -16776961
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
        End With

        .Range("B1").Value = "06:00"
        .Range("C1").Value = "07:00"
        .Range("D1").Value = "08:00"
        .Range("E1").Value = "09:00"
        .Range("F1").Value = "10:00"
        .Range("G1").Value = "11:00"
        .Range("H1").Value = "12:00"
        .Range("I1").Value = "13:00"
        .Range("J1").Value = "13:30"
        .Range("K1").Value = "14:00"
        .Range("L1").Value = "15:00"
        .Range("M1").Value = "16:00"
        .Range("N1").Value = "17:00"

        With .Range("B1:N1")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With

        With .Range("E1,J1,N1")
            .Font.Bold = True
        End With

        .Range("J1").Font.Color = -65281

        With .Range("O1:Q1")
            .Merge
            .Value = "Shift"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With

        With .Range("O2")
            .Value = "Number:"
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With

        With .Range("P2")
            .Value = "Start"
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
        End With

        With .Range("Q2")
            .Value = "End"
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
        End With

        .Range("P2:Q2").Interior.Color = 65535

    End With

    'Loop Roster
    With ThisWorkbook.Worksheets("ROSTER")

        For i = 2 To LastRowSR

            strName = .Range("A" & i).Value
            strNumber = .Range("B" & i).Value
            strStart = Format(.Range("D" & i).Value, "hh:mm")
            strEnd = Format(.Range("E" & i).Value, "hh:mm")
            strSection = .Range("F" & i).Value

            With ThisWorkbook.Worksheets("HEADCOUNT")

                LastRowSH1 = .Cells(.Rows.Count, "A").End(xlUp).Row

                If LastRowSH1 = 1 Then
                    With .Range("A" & LastRowSH1 + 1)
                        .Value = strSection
                        .Font.Bold = True
                    End With
                    .Range("A" & LastRowSH1 + 2).Value = strName
                    .Range("O" & LastRowSH1 + 2).Value = strNumber
                    .Range("P" & LastRowSH1 + 2).Value = strStart
                    .Range("Q" & LastRowSH1 + 2).Value = strEnd
                ElseIf strSection = .Range("A" & LastRowSH1 - 1).Value Then
                    .Range("A" & LastRowSH1 + 1).Value = strName
                    .Range("O" & LastRowSH1 + 1).Value = strNumber
                    .Range("P" & LastRowSH1 + 1).Value = strStart
                    .Range("Q" & LastRowSH1 + 1).Value = strEnd
                Else
                    With .Range("A" & LastRowSH1 + 2)
                        .Value = strSection
                        .Font.Bold = True
                    End With
                        .Range("A" & LastRowSH1 + 3).Value = strName
                        .Range("O" & LastRowSH1 + 3).Value = strNumber
                        .Range("P" & LastRowSH1 + 3).Value = strStart
                        .Range("Q" & LastRowSH1 + 3).Value = strEnd
                End If

                .UsedRange.Columns.AutoFit

            End With

        Next i

    End With

End Sub
相关问题