多个范围对于Excel VBA中的每个循环

我有一个表格，下面的数据。

Category | Amount | Daily Charges | Misc Charges | Vendor Charges ------------ |-----------| --------------|--------------|------------------- Daily Charges |500,000.00 | | | --------------|-----------|---------------|--------------|------------------- Misc Charges | 500.00 | | | --------------|-----------| --------------|--------------|------------------- Vendor Charges| 50,000.00 | | | 

我需要使用macros填写第3栏（每日收费），第4栏（杂项费用）和第5栏（供应商费用）。

 Category | Amount | Daily Charges | Misc Charges | Vendor Charges ------------ |-----------| --------------|--------------|------------------- Daily Charges |500,000.00 | 500,000.00 | 0 | 0 --------------|-----------|---------------|--------------|------------------- Misc Charges | 500.00 | 0 | ₹ 500.00 | 0 --------------|-----------| --------------|--------------|------------------- Vendor Charges| 50,000.00 | 0 | 0 | 50,000.00 

请帮忙。

我试过下面的macrosfunction，但我无法从每个循环的范围正确退出。

 Sub LoopInsert() Dim tgt, final, rng, val, cell, cell2, cell3 As Range Worksheets("Sheet1").Activate Set rng = ActiveSheet.Range("A2", ActiveSheet.Range("A2").End(xlDown)) Set val = ActiveSheet.Range("B2", ActiveSheet.Range("B2").End(xlDown)) Set tgt = ActiveSheet.Range("C2", ActiveSheet.Range("C2").End(xlDown)) For Each cell In rng For Each cell2 In val If cell.Value = "Daily Charges" Then Exit For For Each cell3 In tgt cell3.Value = cell2.Value Exit For Next Else For Each cell3 In tgt cell3.Value = 0 Exit For Next End If Next Next End Sub 

Answer 1

你不需要这个macros。 你可以用公式来做到这一点

 =IF($C$1 = A2, B2, 0) =IF($D$1 = A2, B2, 0) =IF($E$1=A2, B2, 0) 

将它们粘贴到C2，D2，E2中，然后复制其余单元格的公式

或者YowE3K指出你可以在单元格C2中使用= IF（C $ 1 = $ A2，$ B2,0），并复制到所有其他单元格（即C2：E4）

Answer 2

坚持VBA可以简化代码并减less运行时间

 Option Explicit Sub LoopInsert() Dim catColumnRng As Range, catRowRng As Range, colRng As Range, cell As Range With Worksheets("Sheet1") Set catColumnRng = .Range("A2", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| store all "Category" not empty cells in column A from row 2 downwards Set catRowRng = .Range("C1", .Cells(1, .Columns.Count).End(xlToLeft)).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| store all "Category" not empty cells in row 1 from column 3 rightwards For Each cell In catColumnRng '<--| loop through column A "Category" cells Set colRng = catRowRng.Find(what:=cell.Value, LookIn:=xlValues, lookat:=xlWhole) '<--| try finding corresponding text in row 1 "Category" cells If Not colRng Is Nothing Then .Cells(cell.Row, colRng.Column).Value = cell.Offset(, 1) '<--| if found then place the value Next cell End With End Sub