TEST

'
Option Explicit
'Dim driver As New Selenium.EdgeDriver
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
#Else
    
#End If


Public 結合 As Variant
Public 行CNT As Long
Public Adic As Variant

'2025/3/19

Sub 結合判定()
    Dim WSscrip As Worksheet
    Set WSscrip = ThisWorkbook.ActiveSheet
    Dim 最終行 As Long
    Dim 最終列 As Long
    Dim 数値CNT As Long
    Dim 列 As Long
    Dim i As Long
    With WSscrip
        'セルの結合に備えて最終行と最終列を取得する
        最終行 = .Cells(.Rows.count, 1).End(xlUp).Offset(1, 0).Row - 1
        最終列 = .Cells(1, .Columns.count).End(xlToLeft).Offset(0, 1).Column - 1
        '--------------------------
        ReDim 結合(最終列 - 1) As Variant
        Dim 配列CNT As Long
        Dim Cntlong1   As Long
        
       
        
        
        ' 1列の結合を確認する
        For i = 1 To 最終列
          If .Cells(行CNT, i).MergeCells Then
                With .Cells(行CNT, i).MergeArea
                        If .Columns.count = 1 Then
                            結合(i - 1) = True
                            
                        Else
                            
                            If .Columns.count = 2 Then
                                '2列の場合は次の列をtrueにする
                                結合(i - 1) = False
                                結合(i) = True
                                i = i + 1
                            Else
                                Cntlong1 = i + .Columns.count - 1
                                For 配列CNT = i To Cntlong1
                                    
                                    If 配列CNT = Cntlong1 Then
                                        結合(配列CNT - 1) = True
                                    Else
                                        結合(配列CNT - 1) = False
                                    End If
                                    i = i + 1
                                Next
                                i = i - 1
                            End If
                            

                        End If
                End With
          Else
            結合(i - 1) = True
          End If
          
        Next
        
        
        'msg = msg & "列数：" & .Columns.count & vbCrLf.Rows.count
        
        '--------------------------
    
    End With
    

End Sub



Sub WEBスクレイピング()

    Dim rslt As VbMsgBoxResult


    Dim WSscrip As Worksheet
    Set WSscrip = ThisWorkbook.ActiveSheet
    
    If WSscrip.Name = "Sheet1" Then
        MsgBox "取り込みを実施するシートをアクティブな状態で実行して下さい。"
        Set WSscrip = Nothing
        Exit Sub
    End If
    
    '清書のフォーマットと列幅を統一する。H120　J125　K145　L131　M124
    Dim 最終行 As Long
    Dim 最終列 As Long
    Dim 数値CNT As Long
    Dim 列 As Long
    Dim i As Long
           
'    rslt = MsgBox("実行しますか？", Buttons:=vbOKCancel)
'    If rslt = 2 Then
'           MsgBox "終了します。"
'            Exit Sub
'    End If
        
    
    With WSscrip
        'セルの結合に備えて最終行と最終列を取得する
        最終行 = .Cells(.Rows.count, 1).End(xlUp).Offset(1, 0).Row - 1
        最終列 = .Cells(1, .Columns.count).End(xlToLeft).Offset(0, 1).Column - 1
        
        '配列はゼロからカウント　列の幅を入れる
        ReDim Adic(最終列 - 1) As Variant
        列 = 0
        For i = 1 To 最終列
            Adic(列) = .Columns(i).ColumnWidth
            '列を整数で表示する為、整形する。
            Adic(列) = Int(Adic(列))
            .Columns(i).ColumnWidth = Adic(列)
            列 = 列 + 1
        Next
        
        Dim TEXT行区切り As String
        Dim j As Long
        
'        For i = 1 To 最終列
'            If i = 1 Then TEXT行区切り = "|"
'            For j = 1 To Adic(i - 1)
'                If j = Adic(i - 1) Then
'                    TEXT行区切り = TEXT行区切り & "|"
'                Else
'                    TEXT行区切り = TEXT行区切り & "-"
'                End If
'            Next
'        Next
'
'        TEXT行区切り = TEXT行区切り & vbLf
'
'        'デバック用に表示する。
'         .Cells(5, 6) = TEXT行区切り
            
       Dim JJJ As Long
       Dim J2byte As Long
       Dim cntclm As Long, rAngeCEL
       Dim FRG As Boolean
       ReDim 変数(最終列)
       
       FRG = False
        
        
        
        行CNT = 1
     
        結合判定
        For i = 1 To 最終列
            
            J2byte = 0
            '行の先頭で｜を入れる判定
            If i = 1 Then
                TEXT行区切り = TEXT行区切り & "|" & .Cells(行CNT, i)
                '配列に入っている列幅から文字を引いて列を整える
                 J2byte = CountDoubleByteChars(.Cells(行CNT, i))
                JJJ = Adic(i - 1) - (J2byte + 1)
            Else
                TEXT行区切り = TEXT行区切り & .Cells(行CNT, i)
                 J2byte = CountDoubleByteChars(.Cells(行CNT, i))
                JJJ = Adic(i - 1) - J2byte
            End If
                
            '文字の後ろにスペースが無い場合は課「｜」を入れる
            If JJJ = 1 Then
                
                TEXT行区切り = TEXT行区切り & "|"
            Else
                For j = 1 To JJJ
                    If j = JJJ Then
                        
                        If 結合(i) = True Then
                            TEXT行区切り = TEXT行区切り & "|"
                        Else
                            TEXT行区切り = TEXT行区切り & " "
                        End If
                    
                    
                    End If
                Next
            End If
        Next
            
            
         .Cells(2, 3) = TEXT行区切り
            
'
'        '2行目　見出し部分
'        Dim タイトル As String
'        Dim 見出し As String
'        Dim JJ As Long
'        Dim ii As Long
'
'        For i = 1 To 最終列
'            タイトル = .Cells(1, i)
'            If i = 1 Then
'                見出し = "|" & タイトル
'                JJ = Adic.Item(i - 1) - LenB(見出し) - 1
'            Else
'                見出し = 見出し & タイトル
'                JJ = A列 - Len(見出し)
'           End If
'           For ii = 1 To JJ
'            見出し = 見出し & " "
'           Next
'        見出し = 見出し & "|"
'        Next
'
'
'        .Cells(2, 6) = TEXT行区切り
'        .Cells(3, 6) = 見出し
           


    End With
End Sub




Sub 幅を計る()

   Dim WSscrip As Worksheet
    Set WSscrip = ThisWorkbook.ActiveSheet
    
    
    
    If WSscrip.Name = "Sheet1" Then
        MsgBox "取り込みを実施するシートをアクティブな状態で実行して下さい。"
        Set WSscrip = Nothing
        Exit Sub
    End If
    
    WSscrip.Cells.Font.Name = "MS ゴシック"
    WSscrip.Cells.Font.Size = 11
    
    '清書のフォーマットと列幅を統一する。H120　J125　K145　L131　M124
    Dim 最終行 As Long
    Dim 最終列 As Long
    Dim 数値CNT As Long
    Dim A列 As Long
    Dim B列 As Long
    Dim C列 As Long
    Dim D列 As Long
    Dim E列 As Long
    Dim F列 As Long
    
    With WSscrip
    
        最終行 = .Cells(.Rows.count, 1).End(xlUp).Offset(1, 0).Row - 1
        最終列 = .Cells(1, .Columns.count).End(xlToLeft).Offset(0, 1).Column - 1
        A列 = .Columns(1).ColumnWidth
            A列 = Int(A列)
            .Columns(1).ColumnWidth = A列
        
        B列 = .Columns(2).ColumnWidth
            B列 = Int(B列)
            .Columns(2).ColumnWidth = B列
        
        C列 = .Columns(3).ColumnWidth
            C列 = Int(C列)
            .Columns(3).ColumnWidth = C列
        
        D列 = .Columns(4).ColumnWidth
            D列 = Int(D列)
            .Columns(4).ColumnWidth = D列
            
         E列 = .Columns(5).ColumnWidth
            E列 = Int(E列)
            .Columns(5).ColumnWidth = E列
            
         F列 = .Columns(6).ColumnWidth
            F列 = Int(F列)
            .Columns(5).ColumnWidth = F列
        
        Select Case 最終列
            Case 1
             MsgBox "Ｊ列の幅は125まで使用できます。A列 " & A列 & "です。合計　" & A列
            Case 2
             MsgBox "Ｊ列の幅は125まで使用できます。A列 " & A列 & " B列 " & B列 & "です。合計　" & A列 + B列
            Case 3
             MsgBox "Ｊ列の幅は125まで使用できます。A列 " & A列 & " B列 " & B列 & " C列 " & C列 & "です。合計　" & A列 + B列 + C列
            Case 4
             MsgBox "Ｊ列の幅は125まで使用できます。" & _
             vbCrLf & "A列 " & A列 & " B列 " & B列 & " C列 " & C列 & " D列 " & D列 & "です。合計　" & A列 + B列 + C列 + D列
            Case 5
             MsgBox "Ｊ列の幅は125まで使用できます。" & _
             vbCrLf & "A列 " & A列 & " B列 " & B列 & " C列 " & C列 & " D列 " & D列 & " E列 " & E列 & "です。合計　" & A列 + B列 + C列 + D列 + E列
            Case 6
              MsgBox "Ｊ列の幅は125まで使用できます。" & _
             vbCrLf & "A列 " & A列 & " B列 " & B列 & " C列 " & C列 & " D列 " & D列 & " E列 " & E列 & "です。合計　" & A列 + B列 + C列 + D列 + E列
            Case Else
             MsgBox "7列は想定以上です、対応出来るように作成出来ていません。"
             Exit Sub
        End Select


End With

End Sub



Function CountDoubleByteChars(ByVal str As String) As Long
    Dim i As Long
    Dim count As Long
    count = 0
    
    For i = 1 To Len(str)
        
        If Len(Mid(str, i, 1)) <> LenB(StrConv(Mid(str, i, 1), vbFromUnicode)) Then
            count = count + 2
            
        Else
            count = count + 1
        End If
    Next i
    
    CountDoubleByteChars = count
End Function