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

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

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

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

我想要做的是扫描任务的某种types的任务，然后一旦我find任务，我输出描述信息在正确的相应财政年度。

我觉得这将需要一个DO循环和一个如果然后，但我所尝试的是不工作的组合。 下面是我开始，很快就知道这是行不通的。

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
• testing/空白/ FY16Q3
• 示例/ B / FY15Q3
• 示例/ B / FY16Q1
• 会议/空白/ FY15Q2
• testing/空白/ FY16Q3
• 示例/ C / FY16Q2

输出数据

• FY15 / A / B
• FY16 / B / C

每个财政年度最多可达6个

Answer 1

几个快速debugging的东西。 试试这个，让我知道你是否仍然需要帮助。 我希望这会使代码工作，我相信你的如果然后逻辑是正确的。

 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 

编辑：评论后，这是我做的。 我使用上面添加的input创build了一个虚拟工作表。 我把这个表格称为“RawData”。 我创build了另一个名为“OutputData”的表单。 在OutputData中，我在单元格A1-A4中增加了FY15-FY18。 macros代码是这样的。 请注意，这可能更漂亮，但它应该工作并且足够dynamic，以支持此电子表格的演变。

 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