Excel

数値と文字の混在

「データ」→「区切り位置」を選択する
「列のデータ形式」で「文字列」を選択して「完了」

最終行を探し、飛び飛びの列を選択

   Sub test()
   
   Dim r As Range
   Dim MaxRow As Long
   Dim ar As Variant
   Dim buf As Variant
   
   Dim i As Integer
   
   Set r = ActiveSheet.UsedRange
   ar = Evaluate("(" & r.Address & "<>"""")*(ROW(" & r.Address & "))")
   For i = r.Rows.Count To 1 Step -1
         buf = WorksheetFunction.Index(ar, i, 0)
         MaxRow = WorksheetFunction.Max(buf)
         If MaxRow > 0 Then
           Exit For
         End If
   Next
     MsgBox MaxRow
       
       With ActiveSheet
           Union(.Range("A1:D" & i), .Range("G1:G" & i)).Select
       End With
         
   End Sub

Excel設定

Dim xlApp As New Excel.Application
Dim xlWb As New Excel.Workbook
  
    MyPath = CurrentProject.Path & "\Test.xlsx"
   Set xlApp = CreateObject("excel.application")
   Set xlWb = xlApp.Workbooks.Open(FileName:=MyPath)
   xlApp.DisplayAlerts = False
   
   'xlWb.ActiveSheet.Cells.WrapText = False         '折り返し無効
   'xlWb.ActiveSheet.Cells.EntireColumn.AutoFit     '例全体のセル幅調整    
   xlWb.Worksheets("AAA").Columns(1).Delete                     '2列目削除
   xlWb.Worksheets("AAA").Cells.WrapText = False                '折り返し無効
   xlWb.Worksheets("AAA").Cells.EntireColumn.AutoFit           '例全体のセル幅調整
   xlWb.Worksheets("AAA").Cells.HorizontalAlignment = xlCenter  '文字の配置
   'xlWb.Worksheets("AAA").Rows(1).Interior.ColorIndex = 11      '背景色
   xlWb.Worksheets("出力").Rows(1).Interior.Color = RGB(23, 55, 93)
   xlWb.Worksheets("AAA").Rows(1).Font.ColorIndex = 2           '文字色    
   
   'A列同一値の結合
   With xlWb.ActiveSheet
   i = 2　'2行目から
   j = i + 1
     Do While .Cells(j, 1).Value <> ""
         If .Cells(i, 1).Value = .Cells(j, 1).Value Then
              .Range(.Cells(i, 1), .Cells(j, 1)).MergeCells = True
              j = j + 1
         Else
              i = j
              j = j + 1
         End If
     Loop
  End With
  
  xlWb.ActiveSheet.SaveAs MyPath, , , , , False   'バックアップ.xlkを作成しない
  xlWb.Close SaveChanges:=True
  xlApp.Quit
  xlApp.DisplayAlerts = True
  
  Set xlWb = Nothing
  Set xlApp = Nothing