- 日時: 2012/06/06 19:12
- 名前: VBレスキュー(花ちゃん)
- ***********************************************************************************
* カテゴリー:[エクセル][][] * * キーワード:Excel VBA,Excel2010,R1C1形式,A1形式,セル番地,行番,列番,列数,行数 * *********************************************************************************** '=================================================================================================== '投 稿 日:2012.05.06 '投 稿 者:VBレスキュー(花ちゃん) 'タイトル:A1形式をR1C1形式に変換する関数及びその使用例 '========1=========2=========3=========4=========5=========6=========7=========8=========9=========0 >>16 R1C1形式をA1形式に変換する関数及びその使用例 の逆に変換する関数です。 仕様等は、上記同様ですので、上記関数の説明文等もご覧下さい。
初め、計算式で求める方法で作ったのですが、複雑になり、範囲指定の場合まで対応できず、Excel の Address 関数を使った方法で、"A2:AZZ200" のような指定もできるようにも作ってみました。 使用する場面に合せるなり、改造するなりして使って見て下さい。 '--------------------------------------------------------------------------------------------------
Private Sub Button15_Click(sender As System.Object, e As System.EventArgs) Handles Button15.Click
'=================== A1形式をR1C1形式に変換する関数 ========================== Dim A1 As String = "AZZ200" '行番 'Excel の裏に隠れたりしますので、オーナーウィンドウ(Me)を指定下さい。 Dim r1a1() As Integer = A1ToR1(A1) '結果 AZZ200 = 200,1378 です。 MessageBox.Show(A1 & " = " & r1a1(0).ToString() & "," & r1a1(1).ToString() & " です。")
'=============================================================================
Call ExcelOpen("", "") '新規ファイルをオープンして、Excel を起動 xlApp.Visible = False '-------------------------------------------------------------------------- 'Excel の Address 関数を使った方が簡単かも Dim xlRange As Excel.Range xlRange = xlSheet.Range("AZZ200") Dim Col() As String = xlRange.Address(True, True, _ Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c) MessageBox.Show("AZZ200 = " & Col(0) & " , " & Col(1) & " です。") MRComObject(xlRange)
Dim r1c1() As Integer = A1ToR1C1("A2:AZZ200") '結果 [A2:AZZ200] = 2,1,200,1378 です。 MessageBox.Show("[A2:AZZ200] = " & r1c1(0).ToString() & "," & r1c1(1).ToString() & _ " , " & r1c1(2).ToString() & "," & r1c1(3).ToString() & " です。")
'=============================================================================
'Excelファイルを上書き保存(True 又省略すれば)して終了処理を実行 Call ExcelClose(IO.Path.GetFullPath(".\Test.xlsx"), False) 'False の場合保存しないで終了 'Excel.EXE がタスクマネージャに残っていないか調査(実使用時は必要なし) Call ProcessCheck() End Sub
Private Function A1ToR1C1(ByVal A1 As String) As Integer() 'A1形式をR1C1形式に変換する関数(Excel の Address 関数を使った方法) Dim adr1 As String = "A1" Dim adr2 As String = "A1" Dim r1c1(3) As Integer If A1.IndexOf(":") > 0 Then Dim wrk() As String = A1.Split(":"c) adr1 = wrk(0) adr2 = wrk(1) Else adr1 = A1 adr2 = "A1" End If Dim xlRange As Excel.Range xlRange = xlSheet.Range(adr1) Dim Col() As String = xlRange.Address(True, True, _ Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c) MRComObject(xlRange) 'ここも参照先が変わるので
r1c1(0) = CInt(Col(0)) r1c1(1) = CInt(Col(1)) xlRange = xlSheet.Range(adr2) Dim Col1() As String = xlRange.Address(True, True, _ Excel.XlReferenceStyle.xlR1C1).Replace("R", "").Split("C"c) r1c1(2) = CInt(Col1(0)) r1c1(3) = CInt(Col1(1)) MRComObject(xlRange) Return r1c1 End Function
Private Function A1ToR1(ByVal A1 As String) As Integer() 'A1形式をR1C1形式に変換する関数(計算式で求める方法) Dim R1A1(1) As Integer R1A1(0) = 0 R1A1(1) = 0 A1.ToUpper() Dim nLen As Integer = A1.Length Dim strColum As String = "" Dim strRow As String = ""
For i As Integer = 0 To nLen - 1 Dim wrk As String = A1.Substring(i, 1) If AscW(wrk) >= 64 And AscW(wrk) <= 90 Then strColum &= wrk ElseIf AscW(wrk) >= 48 And AscW(wrk) <= 57 Then strRow &= wrk Else MessageBox.Show("指定が間違っています。") Return R1A1 End If Next Debug.Print(strColum & " : " & strRow) A1 = strColum Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Dim B1 As String = A1.ToUpper Dim A2 As String = "" Dim n As Integer = B1.Length If n > 3 Then n = 3 For i As Integer = 0 To n - 1 If s.IndexOf(B1.Substring(i, 1)) >= 0 Then A2 &= B1.Substring(i, 1) End If Next n = A2.Length Dim C1 As Integer = 0 If n = 1 Then C1 = s.IndexOf(A2) + 1 ElseIf n = 2 Then C1 = (s.IndexOf(A2.Substring(0, 1)) + 1) * 26 C1 += s.IndexOf(A2.Substring(1, 1)) + 1 Else C1 = ((s.IndexOf(A2.Substring(0, 1)) + 1) * 676) C1 += (s.IndexOf(A2.Substring(1, 1)) + 1) * 26 C1 += s.IndexOf(A2.Substring(2, 1)) + 1 End If R1A1(0) = CInt(strRow) R1A1(1) = C1 Return R1A1 End Function
Private Function R1ToA1(ByVal r1 As Integer, ByVal c1 As Integer) As String 'R1C1形式のアドレスをA1形式に変換する関数 Dim s As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" Dim A1 As String = "" If c1 < 1 Or c1 > 16384 Then MessageBox.Show("指定が間違っています。") A1 = "A1" Return A1 End If If c1 <= 26 Then A1 = s.Chars(c1 - 1) & CStr(r1) ElseIf c1 <= 702 Then A1 = s.Chars(((c1 - 1) \ 26) - 1) & s.Chars(((c1 - 1) Mod 26)) & CStr(r1) Else A1 = s.Chars(((c1 - 703) \ 676)) & s.Chars((((c1 - 703) \ 26) Mod 26)) & _ s.Chars(((c1 - 1) Mod 26)) & CStr(r1) End If Return A1 End Function
|