VBAのお勉強　Excelの操作などなど

http://q.hatena.ne.jp/1199348584

まず、ワークシート名の一覧を取得します。

Yahoo!で、「vba excel ワークシート名　取得」で検索すると、

http://www.relief.jp/itnote/archives/000960.php
が出てきました。

ここに載っているサンプルは、シート名をセルに代入していくようなので、これをDebug.Printするようにしてみます。

Sub test()
        Dim objSheet As Object
        For Each objSheet In ActiveWorkbook.Sheets
                Debug.print objSheet.Name
        Next
End Sub

ん、いい感じ(^^)

次は、「シート名が「はてな」か、半角数字の場合」ですね。
シート名が「はてな」は簡単だけど、「半角数字の場合」が難しいですね。

他の言語だと、「正規表現」なんかを使うところだと思うので、Yahoo!で「vba excel 正規表現」で検索してみると、、、
http://codezine.jp/a/article/aid/1655.aspx
によると、「RegExpオブジェクト」なるものを参照設定しないと駄目らしい。
この手の「参照設定」は、プログラムを使う際設定しないといけないと思うので、あんまり好きじゃないんですよね～。
「このプログラムを使いたいなら、事前にいろいろ設定して～」というのは、めんどくさいですし。

なので、参照設定とかを出来るだけ使わないでやってみることにします。

Yahoo!で「vba excel 半角数字か」で検索すると、
http://oshiete1.goo.ne.jp/c257.html?start=7296
が見つかりました。この中から、
半角数字かどうかの判定
http://oshiete1.goo.ne.jp/qa2404154.html
を見ていくと、
http://homepage1.nifty.com/rucio/main/technique/InputChk2.htm
が紹介されています。

これによると、IsNumericなる関数があるようですが、それでは対象文字列が「3D2」などの場合、数字じゃないのに数字とみなされてしまうようなので、一文字ずつばらしてみていったほうが良いみたいですね。

対象の数字が半角数字かどうかをチェックする関数 hankakusuujicheckを作ってみます。
hankakusuujicheck(“123″)→true
hankakusuujicheck(“abc”)→false
こんな感じになるように。

Sub test()
        If hankakusuujicheck("123") Then
                        Debug.Print "123は半角数字だよ"
                Else
                        Debug.Print "123は半角数字じゃないよ"
        End If

        If hankakusuujicheck("abc") Then

                        Debug.Print "abcは半角数字だよ"

                Else

                        Debug.Print "abcは半角数字じゃないよ"

        End If

End Sub

Function hankakusuujicheck(ByVal checkvalue As String) As Boolean

        Dim i As Integer

        For i = 1 To Len(checkvalue)

                If Not Mid(checkvalue, i, 1) Like "[0-9]" Then Exit Function

        Next

        hankakusuujicheck = True

End Function

よいようです(^^)

では、シート名が「はてな」か半角数字の場合、シート名を表示させてみます。

Sub test()
        Dim objSheet As Object
        Dim Sheetmei As String
        For Each objSheet In ActiveWorkbook.Sheets
                Sheetmei = objSheet.Name
                If Sheetmei = "はてな" Or hankakusuujicheck(Sheetmei) Then

                        Debug.Print Sheetmei

                End If

        Next

End Sub

Function hankakusuujicheck(ByVal checkvalue As String) As Boolean

        Dim i As Integer

        For i = 1 To Len(checkvalue)

                If Not Mid(checkvalue, i, 1) Like "[0-9]" Then Exit Function

        Next

        hankakusuujicheck = True

End Function

Excelのワークシート名を「はてな」「123」「ほげ」に変えて、プログラムを実行してみます。

ん、よさげ(^^)

次に、「当該シート内におけるA列の全行にある共通の文字列を
「ももんが」に置換するというマクロを作ってください。」とのこと。

「A列の全行」となると、まずA1から縦にどこまでデータが入ってるのかを調べないといけないですね。最後の行を探す方法を検索してみます。

Yahoo!で「excel vba セル 最終行」で検索すると、
http://www.moug.net/tech/exvba/0050088.htm
のページが見つかりました。やりたいことそのまんまです(^^)

Sub test()
    ActiveSheet.Range("A1").End(xlDown).Select
End Sub

として、ExcelのシートのA列にデータを入れてみて、実行します。

ん、確かに、A列でデータが入ってる最後の行まで移動しました。
これで、A列がどの行までデータが入ってるかは取得できました。

A1からこのセルまでの範囲に入ってる文字列を調べる、ということなので、とりあえず、A1からこのセルまでの値を抜き出してみたいと思います。

A1から上の方法で見つけたセルまでを繰り返す、ってことは、

for i=1 to (今見つけたセルの行番号)
Debug.print(「A（i）」のセルの中身)
next i

こんな感じになると思うけど。今いるセルの行番号ってどうやって取得するのかな？
Yahoo!で「excel vba セル 行番号」で検索。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q116001856
によると、ActiveCell.Row で今アクティブなセルの行番号が取得できるらしいので、

Sub test()
    Dim lastgyou As Integer
    Dim i As Integer

    ActiveSheet.Range("A1").End(xlDown).Select
    lastgyou = ActiveCell.Row
    For i = 1 To lastgyou
        Debug.Print (ActiveSheet.Cells(i, 1).Value)
    Next
End Sub

lastgyouという変数に、最後の行の行番号を代入して、
for ループで、１～lastgyouまでのセルの値を表示してみます。

ん、いいんでないかい？(^^)

さて、次は「A列に共通の文字列」を探す、ということなんですが。質問者さんの例で、
「とびうお01」
「とびうお02」
「新とびうお」
とありますが、人間が見て「とびうお」が共通してるなってのは一目瞭然なんですけど、これをプログラムでどうやらせるか、ですよね。

まず、共通してる文字列といっても、「と」「び」「う」「お」の１文字ずつみても、それぞれ共通してますよね？これを「ももんが」に置き換えると、
「ももんがももんがももんがももんが01」
「ももんがももんがももんがももんが02」
「新ももんがももんがももんがももんが」
ってなことにもなりますけど、これは質問者さんの意図するとこではない
ですので、共通していて一番長い文字列、を「ももんが」に置き換える、としてみます。

「全てのA列に共通の文字列」ということは、
「A1に入ってる値の一部分が、A2以降のすべてに含まれている文字列」
と考えればよいですよね？

例えば、上の例ですと、「とびうお01」の「とびうお」という文字列が、それ以降の行に全て入っていますから、これが共通する文字列となります。

それでは、とりあえず、指定した文字列がA2から最後の行までに含まれているかどうかを調べるサブルーチンを作ってみます。

Sub test()
    If zenbuarukadouka("とびうお") Then
        Debug.Print "とびうおはA2以降全てにあります"
        Else
        Debug.Print "とびうおはA2以降でない行もあります"
    End If

    If  zenbuarukadouka("とびうお0") Then
        Debug.Print "とびうお0はA2以降全てにあります"
        Else
        Debug.Print "とびうお0はA2以降でない行もあります"
    End If

End Sub
Function zenbuarukadouka(ByVal check As String) As Boolean
    Dim lastgyou As Integer
    Dim i As Integer
    ActiveSheet.Range("A1").End(xlDown).Select
    lastgyou = ActiveCell.Row

    For i = 2 To lastgyou
        If InStr(ActiveSheet.Cells(i, 1).Value, check) = 0 Then Exit Function
    Next

    zenbuarukadouka = True

End Function

zenbuarukadouka()は、与えられた文字列がA2～最後の行まで含まれているかどうかをチェックします。InStr関数を使って、各セルの値に含まれていなかったら、その場で関数を終了しFalseを返します。全ての行に含まれていたら（つまり、for nextがすべてループしたら）Trueの値を返します。

さて、ということで、このzenbuarukadouka()に、A1の文字列の一部分を与えていけばいいわけですけど、、、

例えば、A1に「あいうえお」という文字が入っていたとします。
A2以降に共通に入っている文字列を zenbuarukadouka()で調べる際に、どのような値を渡せばよいかですが、

長い順から調べていくということですから、５文字の
zenbuarukadouka(“あいうえお”)ですね。次に長いのは４文字の
zenbuarukadouka(“あいうえ”)と、同じく４文字の
zenbuarukadouka(“いうえお”)ということになります。
次は３文字の
zenbuarukadouka(“あいう”)
zenbuarukadouka(“いうえ”)
zenbuarukadouka(“うえお”)
続いて２文字、
zenbuarukadouka(“あい”)
zenbuarukadouka(“いう”)
zenbuarukadouka(“うえ”)
zenbuarukadouka(“えお”)
最後に１文字、
zenbuarukadouka(“あ”)
zenbuarukadouka(“い”)
zenbuarukadouka(“う”)
zenbuarukadouka(“え”)
zenbuarukadouka(“お”)
となります。
これを上から順に調べていって、全ての行で見つかったものがあれば、それが一番長い共通の文字列となります。

Sub test()
Dim i As Integer
Dim j As IntegerDim A1 As String

A1 = "あいうえお"
For i = Len(A1) To 1 Step -1
    For j = 1 To Len(A1) - i + 1
        Debug.Print Mid(A1, j, i)
    Next j
Next i

End Sub

A1という変数に入れられた文字列で、チェック対象となる文字列をDebug.printするプログラムです。

iとjという変数がありますが、iは5～1へ変化します。これは、A1の文字数である5から一番短い文字数の1まで変化する、ということです。
jは、A1の文字列を抜き出す際、何文字目から抜き出すか、を表しています。
これは i によって、値の範囲が変わります。
iが5、つまり、A1の文字数と一緒であれば、jは1～1、つまり、１文字目から5文字抜き出します（あいうえお）。
iが4の場合は、jは1～2、つまり、１文字目から4文字抜き出し（あいうえ）、次に2文字目から4文字抜き出します（いうえお）。
以下、３文字の場合、２文字の場合、１文字の場合も同じように1～3文字目、1～4文字目、1～5文字目が抜き出されるようになっています。

あとは、A1から最後の行まで、見つけた文字列で置換していく部分さえ出来れば完成かな？

A1から最後の行まで、指定した文字列を”ももんが”に置換するプログラムは以下のとおりです。

Sub test()
 chikan ("とびうお")
End Sub

Function chikan(ByVal henkanmoto As String)
 Dim i As Integer
 Dim lastgyou As Integer
 ActiveSheet.Range("A1").End(xlDown).Select
 lastgyou = ActiveCell.Row
 For i = 1 To lastgyou
    ActiveSheet.Cells(i, 1).Value = Replace(ActiveSheet.Cells(i, 1).Value, henkanmoto, "ももんが")
 Next i
End Function

最後の行を求めるのは、さっきまでと同じやりかたで、for nextでループして、全ての行のセルをReplaceを使って、変換元の文字列を”ももんが”に置き換えます。

というデータで実行すると、

となります。

これで必要な機能は全て揃ったので、全部を組み合わせたプログラムを作ってみます。

Sub text()
    Dim objSheet As Object
    Dim Sheetmei As String
    Dim A1 As String
    Dim i As Integer
    Dim j As Integer
    Dim nukidashi As String
    Dim atta As Integer

'現在開いているBookのすべてのSheetをチェックします
  For Each objSheet In ActiveWorkbook.Sheets
    'Sheetmei にシート名を代入します
    Sheetmei = objSheet.Name
    'もし、シート名が「はてな」、もしくは、半角数字の場合、
    If Sheetmei = "はてな" Or hankakusuujicheck(Sheetmei) Then
        'そのシート名のシートを選択します。
        ActiveWorkbook.Sheets(Sheetmei).Select
        '今選択されているシートのA1のセルの値を、A1という変数に代入します。
        A1 = ActiveSheet.Cells(1, 1).Value
        '見つかった場合、ループから抜け出すための変数を0にしておきます。
        atta = 0
        'A1の変数の文字列を長い順に抜き出します。
        For i = Len(A1) To 1 Step -1
            For j = 1 To Len(A1) - i + 1
                'nukidashiという変数に、A1の文字列を抜き出したものを代入します。
                nukidashi = Mid(A1, j, i)
                'もし、nukidashiの文字列がA2以降、すべての行に入っていたら、
                'attaという変数を　1　にして、内側のループを抜けます
                If zenbuarukadouka(nukidashi) Then
                    atta = 1
                    Exit For
                End If
            Next j
            'もし、attaが1の場合、もう見つかっているので、外側のループも抜けます
            If atta = 1 Then Exit For
        Next i
        'もし、attaが1の場合、共通する文字列が見つかったので、A2以降すべてを置き換えます
        If atta = 1 Then
         chikan (nukidashi)
        End If
    End If
  Next
End Sub

Function hankakusuujicheck(ByVal checkvalue As String) As Boolean
Dim i As Integer
For i = 1 To Len(checkvalue)
    If Not Mid(checkvalue, i, 1) Like "[0-9]" Then Exit Function
Next
hankakusuujicheck = True
End Function

Function zenbuarukadouka(ByVal check As String) As Boolean
    Dim lastgyou As Integer
    Dim i As Integer

    ActiveSheet.Range("A1").End(xlDown).Select
    lastgyou = ActiveCell.Row
    For i = 2 To lastgyou
        If (InStr(ActiveSheet.Cells(i, 1).Value, check) = 0) Then Exit Function
    Next
    zenbuarukadouka = True
End Function

Function chikan(ByVal henkanmoto As String)
Dim i As Integer
Dim lastgyou As Integer
ActiveSheet.Range("A1").End(xlDown).Select
lastgyou = ActiveCell.Row
For i = 1 To lastgyou
    ActiveSheet.Cells(i, 1).Value = Replace(ActiveSheet.Cells(i, 1).Value, henkanmoto, "ももんが")
Next i
End Function

ループでシート名を抜き出した後、「はてな」か半角数字の場合、そのシートを選択する必要があるので、
ActiveWorkbook.Sheets(Sheetmei).Select
で選択しています。

それと、文字列の抜き出しを行っている際に、途中で見つかった場合、attaという変数を用いて、ループを抜け、その後の置換処理を行うかどうかも、attaの変数の値を見て判断しています。

では、実際にデータをいれてこのプログラムを動かしてみます。

という状態で実行してみます。

正常に動作しました(^^)

このxlsファイルを置いておきます→vbastudy_0005.xls