2020-05-10

MySQLデータベースと接続してテーブルの内容をセルに表示する

＜分類：データベース＞
＜使用例：MySQLデータベースと接続してテーブルの内容をセルに表示する＞
＜MySQLのサンプルデータベースの構成　※予め作成しておく＞
＜データベース：dbtest1＞
＜テーブル：testtbl1＞
＜テーブルのフィールド：no_id(int型)とnaiyo(varchar型)＞

＜プログラム例＞

Sub Mysql接続SELECT()
    Dim x, x2 As Long
    Dim y As Long
    Dim strSQL As String
    
    Dim adoCn As Object
    Dim adoRs As Object
    
    Set adoCn = CreateObject("ADODB.Connection")
    Set adoRs = CreateObject("ADODB.Recordset")
    
   'SERVER=ローカルの場合localhost
   'DATABASE= useするデータベース名
   'USER= MySQLの管理ユーザ名
   'password= MySQLで設定したパスワード
    adoCn.Open "Driver={MySQL ODBC 8.0 Unicode Driver};" & _
               "SERVER=localhost;" & _
               "DATABASE=dbtest1;" & _
               "USER=root;" & _
               "password=xxxxxxxx;"

    strSQL = "SELECT * FROM testtbl1;"

    Set adoRs = adoCn.Execute(strSQL)
    
    y = 1
    Do Until adoRs.EOF
    
       If y = 1 Then
          For x = 1 To adoRs.Fields.Count
             '先頭フィールド名の設定
              Cells(1, x).Value = adoRs.Fields(x - 1).Name
          Next x
       Else
          Cells(y, 1).Value = adoRs!no_id  'フィールド１内容
          Cells(y, 2).Value = adoRs!naiyo 'フィールド２内容
          adoRs.MoveNext
       End If
         
       y = y + 1
    Loop
      
    adoRs.Close
    adoCn.Close
    
    Set adoRs = Nothing
    Set adoCn = Nothing
    
End Sub

2019-12-22

文字列の両端のみスペースを取り除いて文字列を抜き出す

値取得

＜分類：値抜き取り＞
＜使用例：文字列( 123456789 ABCDEF )から(123456789 ABCDEF)＞
＜プログラム例＞
＜分類：値抜き取り＞

Sub 使用例()
   
   Dim s As String

   s = "   123456789   ABCDEF   "
   
   MsgBox (共通_文字列抜出し両端空白削除(s))

End Sub

Function 共通_文字列抜出し両端空白削除(p1)
'p1:対象文字列

   Dim i As Long
   Dim mojisu As Long
   Dim mojista As Long
   Dim mojiend As Long
   
   mojisu = Len(p1)
   
   共通_文字列抜出し両端空白削除 = ""

   For i = 1 To mojisu - 1
       If Mid(p1, i, 1) = " " Or _
          Mid(p1, i, 1) = "　" Then
       Else
          mojista = i
          Exit For
       End If
   Next i
  
  
   For i = mojisu To 1 Step -1
       If Mid(p1, i, 1) = " " Or _
          Mid(p1, i, 1) = "　" Then
       Else
          mojiend = i
          Exit For
       End If
   Next i
   
    共通_文字列抜出し両端空白削除 = Mid(p1, mojista, mojiend - mojista + 1)
End Function

2019-09-08

ワークシートのデータの最終行を取得する

値取得

＜分類：値取得＞
＜使用例：①上から下方向へデータの入った連続した行の最終行を取得、また、②Excelの最大行から上方向にデータが存在する行まで調べて最終行を取得　①と②お互い一致したら正常、不一致だったら、データの行間に隙間があるので異常（最終行取得エラーとして0を出力）＞
＜注意：サンプルデータを作成するプログラムになっていますので、Sheet1は何もデータがないシートをご用意ください＞
＜プログラム例＞

Sub 使用例()
   Dim max_row As Long
     
  'サンプルデータ作成
   Cells(1, 1) = "2019/9/8"
   Cells(1, 2) = "00:00:00"
   Cells(1, 3) = "28.7"
   
   Cells(2, 1) = "2019/9/8"
   Cells(2, 2) = "01:00:00"
   Cells(2, 3) = "29.0"
   
   Cells(3, 1) = "2019/9/8"
   Cells(3, 2) = "02:00:00"
   Cells(3, 3) = "29.1"
   
   Cells(4, 1) = "2019/9/8"
   Cells(4, 2) = "03:00:00"
   Cells(4, 3) = "29.1"
   
   max_row = 共通_最終行取得("Sheet1")
   Cells(max_row, 1).Select
   
   MsgBox ("最終行は" & max_row & "です")
      
   
End Sub

Function 共通_最終行取得(sheet_name As String)

    Dim maxrow_d As Long
    Dim maxrow_u As Long
    
    maxrow_d = Worksheets(sheet_name).Cells(1, 1).End(xlDown).Row
    maxrow_u = Worksheets(sheet_name).Cells(Rows.Count, 1).End(xlUp).Row
    
    If maxrow_d = maxrow_u Then
       共通_最終行取得 = maxrow_u
    Else
       共通_最終行取得 = 0
       MsgBox ("最終行不一致")
    End If
    
End Function