エクセルVBA練習帳、CSVファイルの活用、カンマ区切りデータベース書出しと読み込み。For…Nextを入れ子で使う、Split関数の使い方などを練習します

CSVファイルの活用
練習帳のダウンロード
1. CSVファイル練習帳
データベースを作成
メインのコード
1. UserFormコード
2. Moduleコード

CSVファイルの活用

筆者の前職は事業所給食サービスの会社で調理師をしていました。仕事柄献立表やレシピ作成のさい食品栄養成分データを扱うことがありました。
具体的には、会社が提供する献立作成システムから献立データをCSVファイルで受け取り、エクセルで加工して食堂内に掲示する献立表やプライスカードなどに表示する栄養情報を自動的に印刷するなどしていました。もちろん、VBAで自動化することで、作業を効率化していたのは言うまでもありません。

食品栄養成分表とは、
メニューのレシピを作成するとき、その献立の栄養成分やカロリーを計算するときに必ず用いられるもので一行の成分項目数は60以上で食品数は2000行位の割と大きな表で構成されています。
（栄養成分表は文部科学省のホームページから八訂Excel版が入手できます。）

栄養成分を計算するソフトなどは会社で用意するシステムではレシピ作成から食材発注、納品、在庫管理など一連の食堂運営を一元的に管理するシステムになっていましたが、全国に数百ある事業所単位では現場のニーズに合わせた細かいデータ処理は各事業所単位に加工できるようCSVファイルで提供するようになっているようでした。

掲示用週間献立表やプライスカードにはその献立のカロリー表示等、主要栄養成分値の表示などを入れ込む必要がありました。また、各事業所管内の保健所への各種提出書類などにも栄養項目のデータを入れ込む必要もあった為、社内システムから吐き出されるCSVファイルを活用することは必須だったわけです。VBAのスキルを活かして自分の仕事環境をより効率的に構築できるのですからぜひとも皆さん方にも挑戦していただきたいと思います。

練習帳のダウンロード

CSVファイル練習帳

1 ファイル 35.68 KB

ダウンロード

データベースを作成

テスト用データベースを作成する

最初に、ダウンロードしたファイルのワークシートには何もデータがありませんから、練習用のデータを書き込みします（データベースを作成）。

メッセージボックスでOKボタンを押して下記の様な簡単な（なんの意味もない）データベースを作ってみました。

データを書き込んだら一旦、保存してファイルを閉じます。

CSVファイルに書き出す

ファイルを開きます。

ダイアログが開いたらデータベースを発見した旨メッセージを確認できます。

書出しボタンを押すと瞬時に作業が終わります。

書き出しましたのメッセージが出るのでOKボタンを押します。

メッセージにはファイルが書き出されたフォルダー名が書いてあります。

（設定ではデスクトップのtesutfoludrに格納するようになってます）

一応確認してみましょう。

上図の様にtestfoldrを開くとファイル名CSVdata.csvがあるので、それを開くと下図のようになっていました。（書き出す前のシート上のセルのデータがカンマを区切りにして書き出されているのがわかりますね。）

CSVファイルに書き出すメイン処理（入れ子のFor…Next）

フォームの書出しボタン　で呼び出されるプロシージャの解説になります。

注目は行番号29行目の　For i= 1 To DBr と、
行番号30行目の　For j = 1 To DBcです。そして、31行目　txt = kanmaText(Cells(g + i, r + j))　の
Cells(g + i, r + j)でワークシートのセルのデータを取り出しています。カンマの左側はセルの行位置で右側が列位置ですから、最初のForでiに１が入ってくるのでシートのデータベースの一行目を意味します。
そして、次の入れ子のForで、一行目の列の位置を順次入れ替えてデータを取り出しています。列のすべてのデータを取り終わったら最初のForに戻って次にiに2が入って2行目のデータの取り出しをするという具合です。DBｒ、ＤＢｃはワークシート上のデータベースの大きさで最大行数と最大列数を表しています。更に、ワークシート上のデータベースの始まる位置情報ｇとｒをプロシージャの引数として受け取ってこれをセルの行と列にそれぞれ加算しています。そして、取り出したデータをkanmaText()関数に送って。データ中にカンマが含まれていた時はこれを取り除いています。

CSVファイルでは、数値表示のなどでカンマを桁区切りにしている場合、（1,200円）等
価格表示で、桁区切りのカンマがあるとデータの区切りのカンマとして扱ってしまうため取り除く必要があります。

Public Sub kakidasi_DBdata_csv(DBr As Integer, DBc As Integer, g As Integer, r As Integer)
'シートにあるDBをカンマ区切りのCSVファイルに書き出す

Dim csvfoldr As String 'フォルダー名用
Dim csvFile As String   'ファイル名用
Dim fnum As Integer     'ファイルナンバー用
Dim i As Long           '行の繰り返し用
Dim j As Long           '列の繰り返し用
Dim txt As String

    'テスト用のフォルダーを作って格納
    csvfoldr = ActiveWorkbook.Path & "\testfoldr"
    
    'フォルダーが無ければ作成
    If Dir(csvfoldr, vbDirectory) = "" Then
        MkDir csvfoldr
    End If
    
    '格納するcsvファイルの名前を設定
    csvFile = csvfoldr & "\CSVdata.csv"
    

    'ファイルナンバーを取得
    fnum = FreeFile
    
    'ファイルを開いてデータを書き込む
    Open csvFile For Output As fnum

    For i = 1 To DBr    '行の繰り返しよう
        For j = 1 To DBc    '列の繰り返し
            txt = kanmaText(Cells(g + i, r + j))    '値にカンマが含まれていたら「”」で囲う。
            If j <> DBc Then
                Print #fnum, txt & ",";
            Else
                Print #fnum, txt & vbCr;
            End If
        Next j
    Next i

    Close #fnum

    MsgBox csvFile & "に書き出しました"

End Sub

Public Sub kakidasi_DBdata_csv(DBr As Integer, DBc As Integer, g As Integer, r As Integer)

'シートにあるDBをカンマ区切りのCSVファイルに書き出す

Dim csvfoldr As String 'フォルダー名用

Dim csvFile As String 'ファイル名用

Dim fnum As Integer 'ファイルナンバー用

Dim i As Long '行の繰り返し用

Dim j As Long '列の繰り返し用

Dim txt As String

'テスト用のフォルダーを作って格納

csvfoldr = ActiveWorkbook.Path & "\testfoldr"

'フォルダーが無ければ作成

If Dir(csvfoldr, vbDirectory) = "" Then

MkDir csvfoldr

End If

'格納するcsvファイルの名前を設定

csvFile = csvfoldr & "\CSVdata.csv"

'ファイルナンバーを取得

fnum = FreeFile

'ファイルを開いてデータを書き込む

Open csvFile For Output As fnum

For i = 1 To DBr '行の繰り返しよう

For j = 1 To DBc '列の繰り返し

txt = kanmaText(Cells(g + i, r + j)) '値にカンマが含まれていたら「”」で囲う。

If j <> DBc Then

Print #fnum, txt & ",";

Else

Print #fnum, txt & vbCr;

End If

Next j

Next i

Close #fnum

MsgBox csvFile & "に書き出しました"

End Sub

保存済みCSVファイルをワークシートに読み込む

前項で書き出したCSVファイルをワークシートに読み込みします。

UserForm１の読込みボタンを押します。

その時点でワークシート上にあるデータベースは削除しますから、OKボタンを押します。

続いて、読込むファイルを選択するダイアログが表示されるので、その中からCSVdata.csvを選択して開きます。（OKボタンを押します）

ほぼ、瞬時にワークシートにCSVファイルの内容がワークシートに張り付きます。

ここからは、フォームの読込みボタンので呼び出されるプロシージャの解説になります。

Public Sub yomikomiKaisi()
    Dim varFileName As Variant
    Dim intFree As Integer
    Dim strRec As String
    Dim strSplit() As String
    Dim i As Long
    Dim j As Long

    ChDir ActiveWorkbook.Path & "\testfoldr"    '開くフォルダーを指定
    
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                               Title:="CSVファイルの選択")
    If varFileName = False Then
        Exit Sub
    End If

    intFree = FreeFile '空番号を取得
    
    Open varFileName For Input As #intFree 'CSVファィルをオープン
  
    i = 0
    Do Until EOF(intFree)
    
        Line Input #intFree, strRec '1行読み込み
        
        i = i + 1
        strSplit = Split(strRec, ",") 'カンマ区切りで配列へ
        
        For j = 0 To UBound(strSplit)
            '一行分ずつデータをシートに書出し
            ActiveSheet.Cells(i, j + 1) = strSplit(j)
        Next
        
    Loop
  
    Close #intFree
    
End Sub

Public Sub yomikomiKaisi()

Dim varFileName As Variant

Dim intFree As Integer

Dim strRec As String

Dim strSplit() As String

Dim i As Long

Dim j As Long

ChDir ActiveWorkbook.Path & "\testfoldr" '開くフォルダーを指定

varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _

Title:="CSVファイルの選択")

If varFileName = False Then

Exit Sub

End If

intFree = FreeFile '空番号を取得

Open varFileName For Input As #intFree 'CSVファィルをオープン

i = 0

Do Until EOF(intFree)

Line Input #intFree, strRec '1行読み込み

i = i + 1

strSplit = Split(strRec, ",") 'カンマ区切りで配列へ

For j = 0 To UBound(strSplit)

'一行分ずつデータをシートに書出し

ActiveSheet.Cells(i, j + 1) = strSplit(j)

Loop

Close #intFree

End Sub

読込み処理の要、Do…Loopを使った繰り返し処理

今までは主にFor…Nextの繰り返し処理を使ってきましたが、ここではDo…Loopを使います。For…Nextは繰り返す回数がわかっているときに使いますが、今回のようなCSVファイルは前もって行数を知ることができないので、その場合は
Do Until EOF()を使います。

Until EOF(intFree)の意味は、
行番号19行目のOpen varFileName For Input As #intFreeで開いたintFree番目のファイルを指定してそのファイルの終端（EOF）に達するまで繰り返しを実行するということです。

次に、
行番号24行目でファイルの一行分を取り出して

行番号27行目でその一行分のデータをカンマで区切って配列に格納します。

そして、今度は入れ子のFor…Nextを使って、一行分のデータが入った配列のデータをワークシートのセルに書き出しています。

行番号29行目　For j = 0 To UBound(strSplit)　の　UBound(strSplit)は引数になっている配列の要素数を返す関数ですから、その要素数だけ繰り返します。

Do…Loopの繰り返しの条件にはUntilとWhileがあります。

Do [While 条件式]
　　・・処理・・
Loop

または、

Do [Until 条件式]
　　・・処理・・
Loop

Whileは、条件を満たしている間（Trueの間）・・処理・・を繰り返します。
Untilは、条件を満たすまで（Falseの間）・・処理・・を繰り返します。

または、

Do
　　・・処理・・
If 条件式 Then Exit Do
Loop
の様な使い方もできます。

いずれにしても何らかの条件式を使って、繰り返しを終了させないと、無限ループになってしまいますから注意が必要です。

メインのコード

UserFormコード

Dim frg As Boolean


Private Sub btnkakidasi_Click()
'書出しボタンの処理
'前提‐‐‐B3から始まるデータベースがある
'データベースの把握
Dim i As Integer
Dim r As Integer
Dim kaisiG As Integer
Dim kaisiR As Integer
Dim idxC As Integer
Dim str As String

If Lsentou.Caption <> "---" Then
    i = Range(Lsentou).CurrentRegion.Columns.Count
    r = Range(Lsentou).CurrentRegion.Rows.Count
    str = Range(Lsentou).Address(, , xlR1C1)
    idxC = InStr(str, "C")
    
    kaisiG = Mid(str, 2, idxC - 2) - 1
    kaisiR = Mid(str, idxC + 1) - 1
    'MsgBox kaisiG & "=" & kaisiR
    Call kakidasi_DBdata_csv(r, i, kaisiG, kaisiR)
End If
End Sub


Private Sub btnyomikomi_Click()
Call csvYomikomi
End Sub

Private Sub CommandButton1_Click()
Call DBfind
End Sub

Private Sub UserForm_Activate()
If frg = True Then Me.Hide
End Sub


Private Sub UserForm_Initialize()
    Call DBfind
    
End Sub
 
'csvファイルを読込んでワークシート上にデータを展開します。
Private Sub csvYomikomi()
    Dim str As String
    Dim sika As String
    Dim adresu As String
    
    str = sentouAddress(TextBox1.Value, TextBox2.Value)
    
    If str <> "" Then
        'ワークシート上にデータベースがあれば削除しておきます。
        If MsgBox("既存のデータベースを、削除してから読込みます。削除してもいいですか？", 17, "削除確認") = vbOK Then
            sika = InStr(str, "■")
            adresu = Mid(str, 1, sika - 1)
            Range(adresu).CurrentRegion.Delete
            MsgBox "ダイアログから、CSVファイルを指定して下さい"
            '読込み開始
            yomikomiKaisi
        End If
    Else
        yomikomiKaisi
    End If
    
End Sub



'データベースを探して、あればcsvデータとして書き出します
Private Sub DBfind()
Dim adresu As String
Dim gyou As String
Dim retu As String
Dim str As String
Dim sika As Integer
Dim gyo As Integer
Dim csvfoldr As String
frg = False
str = sentouAddress(TextBox1.Value, TextBox2.Value)

sika = InStr(str, "■")
gyo = InStr(str, "行")

csvfoldr = ActiveWorkbook.Path & "\testfoldr"
If str = "" And Dir(csvfoldr, vbDirectory) = "" Then
    MsgBox "まず、データベースを作成してください。" & Chr(13) & Chr(13) _
    & "作成後、保存してファイルを閉じて、再度開いて下さい。"
    frg = True
    Exit Sub
ElseIf str = "" Then
    MsgBox "データベースは発見できませんでした。" & Chr(13) & Chr(13) _
    & "行列を調整して再度探索してください" & Chr(13) & Chr(13) _
    & "あるいは、読込みボタンからデータベースを読込んでください"
    CommandButton1.Enabled = True
    btnkakidasi.Enabled = False
Else
    adresu = Mid(str, 1, sika - 1)
    gyou = Mid(str, sika + 1, gyo - sika)
    retu = Mid(str, gyo + 1)
    Lsentou.Caption = adresu
    Label9.Caption = gyou & "、" & retu & "列のデータベースを発見しました"
    CommandButton1.Enabled = False
    btnkakidasi.Enabled = True
    If Dir(csvfoldr, vbDirectory) = "" Then
        btnyomikomi.Enabled = False
    End If
End If
End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

Dim frg As Boolean

Private Sub btnkakidasi_Click()

'書出しボタンの処理

'前提‐‐‐B3から始まるデータベースがある

'データベースの把握

Dim i As Integer

Dim r As Integer

Dim kaisiG As Integer

Dim kaisiR As Integer

Dim idxC As Integer

Dim str As String

If Lsentou.Caption <> "---" Then

i = Range(Lsentou).CurrentRegion.Columns.Count

r = Range(Lsentou).CurrentRegion.Rows.Count

str = Range(Lsentou).Address(, , xlR1C1)

idxC = InStr(str, "C")

kaisiG = Mid(str, 2, idxC - 2) - 1

kaisiR = Mid(str, idxC + 1) - 1

'MsgBox kaisiG & "=" & kaisiR

Call kakidasi_DBdata_csv(r, i, kaisiG, kaisiR)

End If

End Sub

Private Sub btnyomikomi_Click()

Call csvYomikomi

End Sub

Private Sub CommandButton1_Click()

Call DBfind

End Sub

Private Sub UserForm_Activate()

If frg = True Then Me.Hide

End Sub

Private Sub UserForm_Initialize()

Call DBfind

End Sub

'csvファイルを読込んでワークシート上にデータを展開します。

Private Sub csvYomikomi()

Dim str As String

Dim sika As String

Dim adresu As String

str = sentouAddress(TextBox1.Value, TextBox2.Value)

If str <> "" Then

'ワークシート上にデータベースがあれば削除しておきます。

If MsgBox("既存のデータベースを、削除してから読込みます。削除してもいいですか？", 17, "削除確認") = vbOK Then

sika = InStr(str, "■")

adresu = Mid(str, 1, sika - 1)

Range(adresu).CurrentRegion.Delete

MsgBox "ダイアログから、CSVファイルを指定して下さい"

'読込み開始

yomikomiKaisi

End If

Else

yomikomiKaisi

End If

End Sub

'データベースを探して、あればcsvデータとして書き出します

Private Sub DBfind()

Dim adresu As String

Dim gyou As String

Dim retu As String

Dim str As String

Dim sika As Integer

Dim gyo As Integer

Dim csvfoldr As String

frg = False

str = sentouAddress(TextBox1.Value, TextBox2.Value)

sika = InStr(str, "■")

gyo = InStr(str, "行")

csvfoldr = ActiveWorkbook.Path & "\testfoldr"

If str = "" And Dir(csvfoldr, vbDirectory) = "" Then

MsgBox "まず、データベースを作成してください。" & Chr(13) & Chr(13) _

& "作成後、保存してファイルを閉じて、再度開いて下さい。"

frg = True

Exit Sub

ElseIf str = "" Then

MsgBox "データベースは発見できませんでした。" & Chr(13) & Chr(13) _

& "行列を調整して再度探索してください" & Chr(13) & Chr(13) _

& "あるいは、読込みボタンからデータベースを読込んでください"

CommandButton1.Enabled = True

btnkakidasi.Enabled = False

Else

adresu = Mid(str, 1, sika - 1)

gyou = Mid(str, sika + 1, gyo - sika)

retu = Mid(str, gyo + 1)

Lsentou.Caption = adresu

Label9.Caption = gyou & "、" & retu & "列のデータベースを発見しました"

CommandButton1.Enabled = False

btnkakidasi.Enabled = True

If Dir(csvfoldr, vbDirectory) = "" Then

btnyomikomi.Enabled = False

End If

End Sub

Moduleコード

Public Sub yomikomiKaisi()
    Dim varFileName As Variant
    Dim intFree As Integer
    Dim strRec As String
    Dim strSplit() As String
    Dim i As Long
    Dim j As Long

    ChDir ActiveWorkbook.Path & "\testfoldr"    '開くフォルダーを指定
    
    varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _
                                               Title:="CSVファイルの選択")
    If varFileName = False Then
        Exit Sub
    End If

    intFree = FreeFile '空番号を取得
    
    Open varFileName For Input As #intFree 'CSVファィルをオープン
  
    i = 0
    Do Until EOF(intFree)
    
        Line Input #intFree, strRec '1行読み込み
        
        i = i + 1
        strSplit = Split(strRec, ",") 'カンマ区切りで配列へ
        
        For j = 0 To UBound(strSplit)
            '一行分ずつデータをシートに書出し
            ActiveSheet.Cells(i, j + 1) = strSplit(j)
        Next
        
    Loop
  
    Close #intFree
    
End Sub


Public Sub kakidasi_DBdata_csv(DBr As Integer, DBc As Integer, g As Integer, r As Integer)
'シートにあるDBをカンマ区切りのCSVファイルに書き出す

Dim csvfoldr As String 'フォルダー名用
Dim csvFile As String   'ファイル名用
Dim fnum As Integer     'ファイルナンバー用
Dim i As Long           '行の繰り返し用
Dim j As Long           '列の繰り返し用
Dim txt As String

    'テスト用のフォルダーを作って格納
    csvfoldr = ActiveWorkbook.Path & "\testfoldr"
    
    'フォルダーが無ければ作成
    If Dir(csvfoldr, vbDirectory) = "" Then
        MkDir csvfoldr
    End If
    
    '格納するcsvファイルの名前を設定
    csvFile = csvfoldr & "\CSVdata.csv"
    

    'ファイルナンバーを取得
    fnum = FreeFile
    
    'ファイルを開いてデータを書き込む
    Open csvFile For Output As fnum

    For i = 1 To DBr    '行の繰り返しよう
        For j = 1 To DBc    '列の繰り返し
            txt = kanmaText(Cells(g + i, r + j))    '値にカンマが含まれていたら「”」で囲う。
            If j <> DBc Then
                Print #fnum, txt & ",";
            Else
                Print #fnum, txt & vbCr;
            End If
        Next j
    Next i

    Close #fnum

    MsgBox csvFile & "に書き出しました"

End Sub


'書き込む値にカンマが含まれているときは、カンマを取り除く
'（例えば25,000の様な金額表示などの3桁区切り記号が付いているとき）
'（カンマの左右が別データと扱われてしまうためこれを防ぎます）
Private Function kanmaText(txt As String) As String
    
    If InStr(txt, ",") > 0 Then
        kanmaText = Replace(txt, ",", "")
    Else
        kanmaText = txt
    End If
    
End Function


'一列ずつ縦の下方向に調べてデータが発見されたセル範囲の行数と列数を返す
Public Function sentouAddress(gyou As Integer, retu As Integer) As String
Dim r As Integer
Dim i As Integer
Dim adores As String
Dim rowCount As Integer
Dim colCount As Integer

For i = 1 To retu

    For r = 1 To gyou
        If Cells(r, i) <> "" Then
            adores = Cells(r, i).Address
            Range(adores).Select
            rowCount = Range(adores).CurrentRegion.Rows.Count
            colCount = Range(adores).CurrentRegion.Columns.Count
            '最初に見つけたデータが一行だけならそれは表題とみなして無視する
            If rowCount > 1 And colCount > 1 Then
                sentouAddress = adores & "■" & rowCount & "行" & colCount
                Exit Function
            End If
            sentouAddress = ""
        End If
    Next r
    
Next i

End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

Public Sub yomikomiKaisi()

Dim varFileName As Variant

Dim intFree As Integer

Dim strRec As String

Dim strSplit() As String

Dim i As Long

Dim j As Long

ChDir ActiveWorkbook.Path & "\testfoldr" '開くフォルダーを指定

varFileName = Application.GetOpenFilename(FileFilter:="CSVファイル(*.csv),*.csv", _

Title:="CSVファイルの選択")

If varFileName = False Then

Exit Sub

End If

intFree = FreeFile '空番号を取得

Open varFileName For Input As #intFree 'CSVファィルをオープン

i = 0

Do Until EOF(intFree)

Line Input #intFree, strRec '1行読み込み

i = i + 1

strSplit = Split(strRec, ",") 'カンマ区切りで配列へ

For j = 0 To UBound(strSplit)

'一行分ずつデータをシートに書出し

ActiveSheet.Cells(i, j + 1) = strSplit(j)

Loop

Close #intFree

End Sub

Public Sub kakidasi_DBdata_csv(DBr As Integer, DBc As Integer, g As Integer, r As Integer)

'シートにあるDBをカンマ区切りのCSVファイルに書き出す

Dim csvfoldr As String 'フォルダー名用

Dim csvFile As String 'ファイル名用

Dim fnum As Integer 'ファイルナンバー用

Dim i As Long '行の繰り返し用

Dim j As Long '列の繰り返し用

Dim txt As String

'テスト用のフォルダーを作って格納

csvfoldr = ActiveWorkbook.Path & "\testfoldr"

'フォルダーが無ければ作成

If Dir(csvfoldr, vbDirectory) = "" Then

MkDir csvfoldr

End If

'格納するcsvファイルの名前を設定

csvFile = csvfoldr & "\CSVdata.csv"

'ファイルナンバーを取得

fnum = FreeFile

'ファイルを開いてデータを書き込む

Open csvFile For Output As fnum

For i = 1 To DBr '行の繰り返しよう

For j = 1 To DBc '列の繰り返し

txt = kanmaText(Cells(g + i, r + j)) '値にカンマが含まれていたら「”」で囲う。

If j <> DBc Then

Print #fnum, txt & ",";

Else

Print #fnum, txt & vbCr;

End If

Next j

Next i

Close #fnum

MsgBox csvFile & "に書き出しました"

End Sub

'書き込む値にカンマが含まれているときは、カンマを取り除く

'（例えば25,000の様な金額表示などの3桁区切り記号が付いているとき）

'（カンマの左右が別データと扱われてしまうためこれを防ぎます）

Private Function kanmaText(txt As String) As String

If InStr(txt, ",") > 0 Then

kanmaText = Replace(txt, ",", "")

Else

kanmaText = txt

End If

End Function

'一列ずつ縦の下方向に調べてデータが発見されたセル範囲の行数と列数を返す

Public Function sentouAddress(gyou As Integer, retu As Integer) As String

Dim r As Integer

Dim i As Integer

Dim adores As String

Dim rowCount As Integer

Dim colCount As Integer

For i = 1 To retu

For r = 1 To gyou

If Cells(r, i) <> "" Then

adores = Cells(r, i).Address

Range(adores).Select

rowCount = Range(adores).CurrentRegion.Rows.Count

colCount = Range(adores).CurrentRegion.Columns.Count

'最初に見つけたデータが一行だけならそれは表題とみなして無視する

If rowCount > 1 And colCount > 1 Then

sentouAddress = adores & "■" & rowCount & "行" & colCount

Exit Function

End If

sentouAddress = ""

End If

Next r

Next i

End Function