複数の範囲Excel VBAの各ループについて

Question

私は以下のデータを持つシートを持っています。

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

Iは、マクロを使用して以下のように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 

助けてください。

私は以下のマクロ機能を試しましたが、各ループの範囲から正しく終了できません。

Answer 1

このためにマクロは必要ありません。あなたが数式でこれを行うことができ

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

C2、D2、E2でそれらを貼り付け、その後、（細胞

それともYowE3Kはあなたが = IFを使用することができます指摘するように残りの 数式をコピーしますセルC2でC $ 1 = $ A2、$ B2,0）、および他のすべての細胞（すなわちC2にコピー：あなたのコードを簡素化し、実行している時間を減らすことができますVBAにこだわりE4）

Answer 2

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