Question

这对于熟悉VBA的人来说可能是一个简单的问题，但作为一个新手，我完全是空洞的。

我有两张表，一张是原始数据，我已经使用代码从Project中提取而没有任何问题。另一个是输出表。在包含数据的工作表上，我有3列（A，E和H）。列A包含任务列表，列E具有描述，列H具有会计年度和季度。

在输出页面上，我有10年的财政年度。

我要做的是扫描任务以执行某种类型的任务，然后在找到该任务后，我会在正确的相应会计年度中输出描述信息。

我觉得它需要是一个DO循环和If Then的组合，但我尝试的是不起作用。以下是我的开始，很快就知道它不起作用。

Do Until Worksheets("Project Data").Range("A1").Offset(Row, 0).Value = Empty

    If Worksheets("Project Data").Range("A1").Value = "Task example*" Then

        If Worksheets("Project Data").Range("H1") = "FY15*" Then

            If Worksheets("Project Data").Range("E1") = "" Then Worksheets("Output").Range("C5") = 1

        ElseIf Worksheets("Project Data").Range("E1") = "description 1*" Then Worksheets("Output").Range("C5") = 2
        ElseIf Worksheets("Project Data").Range("E1") = "description 2*" Then Worksheets("Output").Range("C5") = 3

        End If

        If Worksheets("Project Data").Range("H1") = "FY16*" Then

            If Worksheets("Project Data").Range("E1") = "" Then Worksheets("Output").Range("C6") = 1

        ElseIf Worksheets("Project Data").Range("E1") = "description 1*" Then Worksheets("Output").Range("C6") = 2
        ElseIf Worksheets("Project Data").Range("E1") = "description 2*" Then Worksheets("Output").Range("C6") = 3

        End If

    Loop

正如我所说，这不是出于多种原因。任何帮助将不胜感激！提前谢谢！

编辑：添加一些虚拟数据。无法弄清楚如何添加附件，并且没有评级来添加图像，所以我有下面的列表，希望这有效。对不起，这太丑了！

原始数据

A栏（任务）/ E栏（说明）/ H栏（FYQ）
示例/ A / FY15Q4
会议/空白/ FY17Q1
测试/空白/ FY16Q3
示例/ B / FY15Q3
示例/ B / FY16Q1
会议/空白/ FY15Q2
测试/空白/ FY16Q3
示例/ C / FY16Q2

输出数据

FY15 / A / B
FY16 / B / C

每个会计年度行可能最多6个

Answer 1

一些快速调试的东西。试试这个，如果你还需要帮助，请告诉我。我希望这会使代码工作一些，我相信你的If Then逻辑是正确的。

Dim row as Integer
row = 0
Do Until Worksheets("Project Data").Range("A1").Offset(row, 0).Value = vbNullString

If Worksheets("Project Data").Range("A1").Value = "Task example*" Then
    If Worksheets("Project Data").Range("H1") = "FY15*" Then
        If Worksheets("Project Data").Range("E1") = "" Then Worksheets("Output").Range("C5") = 1
            ElseIf Worksheets("Project Data").Range("E1") = "description 1*" Then Worksheets("Output").Range("C5") = 2
            ElseIf Worksheets("Project Data").Range("E1") = "description 2*" Then Worksheets("Output").Range("C5") = 3
        End If
    End If
Else
    If Worksheets("Project Data").Range("H1") = "FY16*" Then
        If Worksheets("Project Data").Range("E1") = "" Then Worksheets("Output").Range("C6") = 1
            ElseIf Worksheets("Project Data").Range("E1") = "description 1*" Then Worksheets("Output").Range("C6") = 2
            ElseIf Worksheets("Project Data").Range("E1") = "description 2*" Then Worksheets("Output").Range("C6") = 3
        End If
    End If
End If

row = row + 1

Loop

编辑：评论之后，这就是我的所作所为。我使用上面添加的输入创建了一个虚拟表。我把那张纸称为“RawData”。我创建了第二张名为“OutputData”的表格。在OutputData中，我在单元格A1-A4中添加了FY15-FY18。宏代码就是这样。请注意，这可能更漂亮，但它应该工作并且足够动态以持续该电子表格的演变。

Option Explicit
Sub GenerateOutputDat()
    Dim taskToFind As String, rawData As Worksheet, outputData As Worksheet, startPoint As Integer
    Dim fiscalYears() As String, arraySize As Integer, x As Integer, n As Variant, descr As Range
'Initialize variables
    Set rawData = ActiveWorkbook.Sheets("RawData")
    Set outputData = ActiveWorkbook.Sheets("OutputData")
    taskToFind = "Example"                              'Change this to find different string
'Setup fiscalYears array
    outputData.Activate
    arraySize = Range("A1").End(xlDown).Row - 1         'because VB Arrays start at 0, not 1
    ReDim fiscalYears(arraySize) As String
    For x = LBound(fiscalYears) To UBound(fiscalYears)
        fiscalYears(x) = outputData.Range("A1").Offset(x, 0).Value
    Next
'logic to populate OutputData
    For Each n In fiscalYears
        rawData.Activate
        Range("A1").Select
        startPoint = Cells.Find(n).Row
        On Error GoTo ErrorHandle
        Cells.Find(n, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
        Do
            Set descr = Cells(ActiveCell.Row, 5)
            If Cells(ActiveCell.Row, 1).Value = taskToFind Then
                outputData.Activate
                Cells.Find(n).Activate
                If Cells(ActiveCell.Row, 2).Value = vbNullString Then
                    ActiveCell.Offset(0, 1).Activate
                Else
                    ActiveCell.End(xlToRight).Offset(0, 1).Activate
                End If
                ActiveCell.Value = descr.Value
            End If
            rawData.Activate
            Cells.Find(n, After:=ActiveCell, SearchOrder:=xlByColumns).Activate
        Loop Until ActiveCell.Row <= startPoint
ErrorHandle:
        Range("A1").Activate
    Next
End Sub

Answer 2

这是一种与您所说的不同的方法，但我认为它也可能符合您的需求。你能告诉我是否/如何不这样我可以改善我的答案吗？

Dim rngTasks As Range
Dim cellTasks As Range
Dim lngTasksRow As Long
Dim lngFYRow As Long
Dim cellFY As Range
Dim lngFYCol As Long

With Worksheets("Project Data")
    'How many rows of tasks are there?
    lngTasksRow = .Range("A" & .Rows.Count).End(xlUp).Row
    'Set a range covering every row of tasks
    Set rngTasks = .Range(.Cells(1, 1), .Cells(lngTasksRow, 1)) 'Range to find task in
End With
With Worksheets("Output")
    'For each row in the range
    For Each cellTasks In rngTasks
        'If the task is the one we are looking for
        If cellTasks.Value = Worksheets("Project Data").Range("A1").Value Then
            'How many FY rows are there on "Output"
            lngFYRow = .Range("A" & .Rows.Count).End(xlUp).Row
            'Search to see if the FY we want is already on "Output"
            Set cellFY = .Range(.Cells(1, 1), .Cells(lngFYRow, 1)).Find(What:=cellTasks.Offset(0, 7).Value, After:=.Range("A1"), Lookat:=xlWhole, LookIn:=xlValues, _
                     SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            'If not, use the next blank row; if yes, then use the existing row
            If cellFY Is Nothing Then
                lngFYRow = lngFYRow + 1
            Else
                lngFYRow = cellFY.Row
            End If
            'Find next blank column in FY Row
            lngFYCol = Application.CountA(.Rows(lngFYRow)) + 1
            'Copy the description to that column from "Project Data"
            .Cells(lngFYRow, lngFYCol).Value = cellTasks.Offset(0, 4).Value
        End If
    Next cellTasks
End With

If Then和Do Loop的组合（我认为）

2 个答案: