LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@eriashinichi

TEST

Posted at

'
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

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?