tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
A1形式をR1C1形式に変換する関数及びその使用例(VB.NET) ( No.17 )  [親スレッドへ]
日時: 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



 [スレッド一覧へ] [親スレッドへ]