■
Sub Sample1()
Dim fileList As Collection
Set fileList = New Collection
Dim buf As String, out As String, cnt As Long
Const inputPath As String = "C:\work\"
Const outPath As String = "C:\out\"
buf = Dir(inputPath & "*")
' ファイルリスト取得
Do While buf <> ""
cnt = cnt + 1
fileList.Add inputPath & buf
buf = Dir()
Loop
' ファイル一覧を実行
Dim vItem As Variant
For Each vItem In fileList
Dim TargetBook As Workbook, i As Long, FoundCell As Range
Dim TargetSheet As Worksheet
Dim maxrow As Long
Dim maxcol As Long
Dim startrow '// 先頭行
Dim startcol '// 最終行
Dim j '// ループカウンタ
Set TargetBook = Workbooks.Open(vItem)
Set TargetSheet = TargetBook.Sheets(1)
TargetBook.Activate
With TargetSheet.UsedRange
maxrow = .Rows(.Rows.Count).Row
maxcol = .Columns(.Columns.Count).Column
End With
'// 先頭、最終の行と列を取得
startrow = 5
startcol = 1
Dim kaigyoLength As Long
Const addRowsHeight As String = 20
Dim iRow
Dim addRow
'// 行ループ
For i = startrow To maxrow
iRow = 0
addRow = 0
'// 列ループ
For j = startcol To maxcol
' 結合セル
If TargetSheet.Cells(i, j).MergeCells And Len(TargetSheet.Cells(i, j)) > kaigyoLength Then
With TargetSheet.Cells(i, j).MergeArea
If iRow = 0 Or TargetSheet.Range(TargetSheet.Cells(i, j)).MergeArea.Rows.Count > iRow Then
iRow = TargetSheet.Cells(i, j).MergeArea.Rows.Count
End If
addRow = addRowsHeight
End With
Else
If Len(TargetSheet.Cells(i, j).Value) > kaigyoLength Then
addRow = addRowsHeight
End If
End If
Next
If addRow > 0 Then
TargetSheet.Cells(TargetSheet.Cells(i, j).Row + iRow, j).Rows.Height = addRow
End If
Next
TargetBook.Close
Next vItem
End Sub