表の整形

Visual Basic for Applications

Sub Macro()
  Dim KeyWord As String
  Dim AddedWord As String
  Dim Sheet As Integer
  Dim srrr As Integer
  Dim sccc As Integer
  Dim occc As Integer
  Dim EndRow As Integer
  Dim rrr As Integer
  Dim tmp1 As Variant
  Dim tmp2 As Variant
  Dim Class As String
  KeyWord = "SampleKeyword"
  AddedWord = "SampleWord"
  Sheet = 2
  srrr = 4
  sccc = 1
  occc = 2
  EndRow = Worksheets(Sheet).Cells(srrr, sccc).End(xlDown).Row
  For rrr = srrr To EndRow
    tmp1 = Worksheets(Sheet).Cells(rrr, sccc)
    tmp2 = Worksheets(Sheet).Cells(rrr + 1, sccc)
    If InStr(tmp1, KeyWord) = 0 Then
      Class = tmp1
      If InStr(tmp2, KeyWord) = 0 Then
        Worksheets(Sheet).Cells(rrr, occc) = Class & AddedWord
      Else
        Rows(rrr).Select
        Selection.EntireRow.Hidden = True
      End If
    Else
      Worksheets(Sheet).Cells(rrr, occc) = Class & ":" & Replace(tmp1, KeyWord, "") & AddedWord
    End If
  Next rrr
End Sub