VBA列見出しに空白のセルを見つけよう

Question

私はあなたが助けてくれることを願っています。私は以下のコードをいくつか持っていて、それはやや働いています。私はそれをもっと必要とするだけです。

現在、A1からH1の最初の行に沿っています。ブランクセルが見つかった場合は、セル値をブランクセルの左側にコピーし、この値をブランクセルにペーストしてから移動します。

範囲が日々A1からH1に変わることは十分ではありません。最初の行に沿ってデータを持つ最後のセルが見つかるまで空白を探し、コピーと貼り付けのプロセスを開始するまで、コードを調べる必要があります。

また、ピボットを実行してコピーしたセルと貼り付けたものを区別できるように、貼り付けたセルに2を追加するコードも必要です。

私は理解を深めるために下の図を提供しました。最終結果は、そのセルB2がテキスト24が含まれていなければなりません - 会社：ハイアー2及びE2は、テキスト07が含まれています - 製品：ファミリーハイアー2

私のコードは以下の通りですし、いつものように任意のとすべての助けが大いに感謝します。

ピック1

MY CODE

Public Sub BorderForNonEmpty() 
    Dim myRange As Range 
    Set myRange = Sheet1.Range("A1:H1") 
    For Each MyCell In myRange 
     If MyCell.Text = "" Then 
      MyCell.Offset(0, -1).Select 
     ActiveCell.Copy 
     ActiveCell.Offset(0, 1).PasteSpecial (xlPasteAll) 
     End If 
    Next 
End Sub 

Answer 1

以下のコードを試してみてください - コメントはそれぞれ重要な行が何をしているかを示している：あなたがに見たい

Option Explicit 

Sub FillInHeaders() 

    Dim ws As Worksheet 
    Dim lngRowWithHeaders As Long 
    Dim rngHeader As Range 
    Dim rngCell As Range 

    ' get a reference to your worksheet 
    Set ws = ThisWorkbook.Worksheets("SHeet1") 

    ' set the row that the headers are on 
    lngRowWithHeaders = 2 

    ' get the range from A1 to ??1 where ?? is last column 
    Set rngHeader = ws.Cells(lngRowWithHeaders, 1) _ 
     .Resize(1, ws.Cells(lngRowWithHeaders, ws.Columns.Count) _ 
     .End(xlToLeft).Column) 

    ' iterate the range and look for blanks 
    For Each rngCell In rngHeader 
     ' if blank then ... 
     If IsEmpty(rngCell.Value) Then 
      ' get cell value from left and a 2 
      rngCell.Value = rngCell.Offset(0, -1).Value & "2" 
     End If 
    Next rngCell 

End Sub