そんな時、自由自在に色を操れれば、データの解析や確実に役に立ち、作業効率が爆上げされるはずです。

ExcelVBAだと、カラーインデックス(ColorIndex)やRGB(255, 255, 255)を使うのが主流ですかね。

今現在セルに設定されている色が何色なのか、10進数のRGB形式に変換するとどんな値なのか、16進数の#rrggbb形式だとどうなるのか、知りたくありませんか？

色を扱いやすくできるとWeb作成のスタイルシートなどにも応用できます。オシャレにグラデーションなんか付けて見映えを美しくしたいですね。

そこで、色を超絶簡単に設定、取得、変換するマクロをまとめて作ってみました。

百聞は一見に如かず、一目瞭然、一発でイメージが湧き、使い方がわかるようなGIFアニメ付きです。

コピーするだけなので、試しに使ってみて使えるようであれば、ぜひ使ってみてください。

代表的な色とカラーコード（RGB/16進数）一覧表

まずはよく使う代表的な色の一覧です。マクロでやるともっと便利に自由自在に色を操れるようになります。

背景色、文字色カラーコード一括取得・設定・変換・グラデーション化

シートを見やすくする時、いろんなセルデータの背景色や文字色の設定を色とりどり使い分けると思います。

ネットで見つけて気に入った色をExcelに反映させたい時、いちいちRGBを入力して試すのはクソめんどくさいですね。

特にちょっとオシャレにグラデーションを付けたくなった時は大変な作業です。

大量の色情報を簡単に一発で取得や設定や変換ができるようになったら、もはや色を制したも同然。

それができるようになるのに役立つVBAマクロを作ってみました。

今回作ったマクロは大きく分けて以下４パターンです。

なるべくインターフェースを簡単にし、直感で操作できるように目指してます。詳細な仕様はソース上のコメントなどで補足してます。

今回はセルの背景色と文字色のみですが、図形オブジェクトやシートの色設定などにも応用できると思います。

ちなみにカラーインデックスは取れない場合があるので今回は見送ってます。必要であれば追加してみてください。

RGB値またはRGB10進数またはrrggbb16進数のカラーコードを取得

選択したセルの背景色、または、文字色のカラーコードを一度にすべて取得します。

カラーコード取得の操作イメージ

下記画像にて取得操作のイメージを沸かせてみてください。

いっきにまとめてカラーコードを取得してます。

１列のみを選択します。２列以上の選択は弾きます。選択列の右1列目、2列目、3列目にそれぞれ取得したカラーコードを設定します。

RGB値またはRGB10進数またはrrggbb16進数のカラーコードで設定

選択したセルのカラーコードで背景色、または、文字色を一度にすべて設定します。

カラーコード設定の操作イメージ

下記画像にて設定操作のイメージを沸かせてみてください。

いっきにまとめてカラーコードを設定してます。

数値か、または"rgb("で始まっているか、または"#"で始まっているか、でカラーコードかを判断します。エラーの場合はコメントに追加します。

RGB値またはRGB10進数またはrrggbb16進数のカラーコードを変換

選択したセルのカラーコードをRGB値またはRGB10進数またはrrggbb16進数に一度にすべて変換します。

カラーコード変換の操作イメージ

下記画像にて変換操作のイメージを沸かせてみてください。

いっきにまとめてカラーコードを変換してます。

数値か、または"rgb("で始まっているか、または"#"で始まっているか、でカラーコードかを判断します。すべての組み合わせで変換できます。エラーの場合はコメントに追加します。

RGB値またはRGB10進数またはrrggbb16進数のカラーコードグラデーション設定

選択したセルのカラーコードで背景色、または、文字色を一度にすべて設定します。

カラーコードグラデーション設定の操作イメージ

下記画像にて設定操作のイメージを沸かせてみてください。

いっきにまとめて背景色にグラデーション設定してます。２色で判断するので２列で設定します。

数値か、または"rgb("で始まっているか、または"#"で始まっているか、でカラーコードかを判断します。エラーの場合はコメントに追加します。

背景色、文字色の一括取得・設定・変換VBAマクロの主な仕様

細かい処理はコメントで補足してますが、ザックリとした仕様を箇条書きで記載します。

背景色、文字色の一括取得・設定・変換VBAマクロのソースコード

色取得・設定・変換でデータ解析効率を爆上げしたい方は、下記のソースコードを以下↓↓↓のリンクの内容に従って個人用マクロにコピーしてご使用ください。

【Excel】超便利な個人用マクロブックにVBAを記録追加作成して実行【初心者も簡単】

仕事や勉強を行う上で、Excelを使用するならば、絶対に知っておいた方がよい「個人用マクロブックの設定方法」をまとめました。マクロを頻繁に使用する人、今まで「作業中のブック」のみに個別設定していた人は、自分の作業に合った共通処理のマクロを「...

caymezon.com

2019.03.10

マクロならば、痒いところに手が届きます。用途によっては目的に沿わない可能性がありますが、Const値を持たせてなるべく汎用的に作成しています。

自分に合った方法にカスタマイズしてみてください。VBAマクロの勉強にも少しは役立つと思います。

もし何かバグっていたらごめんなさい。気付いたら改修します。

Sub 選択セルの背景色のカラーコードを取得()

  Const 確認メッセージフラグ = 1 '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const 色取得区分 = 1           '1:背景色から取得、2:文字色から取得
  
  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードを取得(確認メッセージフラグ _
                                                                , 色取得区分)

End Sub
Sub 選択セルの文字色のカラーコードを取得()

  Const 確認メッセージフラグ = 1 '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const 色取得区分 = 2           '1:背景色から取得、2:文字色から取得
  
  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードを取得(確認メッセージフラグ _
                                                                , 色取得区分)

End Sub
Sub RGB値またはRGB10進数またはrrggbb16進数のカラーコードを取得(確認メッセージフラグ As Integer _
                                                             , 色取得区分 As Integer)

  ''''''''''定義''''''''''
  Dim 実行確認 As Integer
  Dim メッセージ As String
  
  Dim 色取得WK As String
  Dim 設定色 As Long
  Dim RGB配列 As Variant
  Dim 赤R, 緑G, 青B As Long
  Dim RGB値 As Long
  Dim RGB_10進数 As String
  Dim rrggbb_16進数 As String
  Dim セル As Range
  
  ''''''''''チェック''''''''''
  If Selection(1).Column < Selection(Selection.Count).Column Then
    MsgBox "右隣のセルに結果を設定するので1列で選択してください。"
    Exit Sub
  End If
  
  ''''''''''確認処理''''''''''
  If 確認メッセージフラグ = 1 Then
  
    If 色取得区分 = 1 Then
      色取得WK = "背景色"
      
    ElseIf 色取得区分 = 2 Then
      色取得WK = "文字色"
      
    End If
    
    メッセージ = メッセージ _
      & "・" & 色取得WK & "のカラーコードを取得し、" _
      & "右隣３セルににRGB値、10進数RGB、16進数#rrggbb、の順に設定します｡ " & vbCrLf _
      & "　既に値がセットされている場合は上書きされます。" & vbCrLf _
      & vbCrLf
      
    '実行確認
    If メッセージ <> "" Then
      実行確認 = MsgBox(メッセージ & vbCrLf _
            & "実行してよろしいですか？", vbYesNo + vbQuestion)
      If 実行確認 = vbNo Then Exit Sub
    End If
    
  End If
  
  ''''''''''色取得処理''''''''''
  For Each セル In Selection
  
    If 色取得区分 = 1 Then
      設定色 = セル.Interior.Color
    ElseIf 色取得区分 = 2 Then
      設定色 = セル.Font.Color
    End If
    
    RGB配列 = RGB値toRGB10進数配列(設定色)
    
    赤R = RGB配列(0)
    緑G = RGB配列(1)
    青B = RGB配列(2)
    
    RGB値 = RGB(赤R, 緑G, 青B)
    
    RGB_10進数 = "rgb(" & 赤R & "," & 緑G & "," & 青B & ")"
    
    rrggbb_16進数 = "#" & Right(0 & hex(赤R), 2) & _
                          Right(0 & hex(緑G), 2) & _
                          Right(0 & hex(青B), 2)
    
    セル.Offset(0, 1).Value = RGB値
    セル.Offset(0, 2).Value = RGB_10進数
    セル.Offset(0, 3).Value = rrggbb_16進数
    
  Next

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub 選択セルのカラーコードで背景色設定()

  Const 確認メッセージフラグ = 1   '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const 色設定区分 = 1             '1:背景色に設定、2:文字色に設定
  
  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードで設定(確認メッセージフラグ _
                                                                , 色設定区分)

End Sub

Sub 選択セルのカラーコードで文字色設定()

  Const 確認メッセージフラグ = 1   '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const 色設定区分 = 2             '1:背景色に設定、2:文字色に設定
  
  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードで設定(確認メッセージフラグ _
                                                                , 色設定区分)

End Sub

Sub RGB値またはRGB10進数またはrrggbb16進数のカラーコードで設定(確認メッセージフラグ As Integer _
                                                             , 色設定区分 As Integer)

  Dim メッセージ As String
  Dim 実行確認 As String
  
  Dim 色設定WK As String
  Dim セル As Range
  Dim RGB配列 As Variant
  Dim RGB値 As Long
  
  ''''''''''確認処理''''''''''
  If 確認メッセージフラグ = 1 Then
  
    If 色設定区分 = 1 Then
      色設定WK = "背景色"
      
    ElseIf 色設定区分 = 2 Then
      色設定WK = "文字色"
      
    End If
    
    メッセージ = メッセージ _
      & "・RGB値、10進数RGB、16進数#rrggbb、いずれかのカラーコードを取得し、" _
      & "セルの" & 色設定WK & "を設定します｡ " & vbCrLf _
      & vbCrLf
      
    '実行確認
    If メッセージ <> "" Then
      実行確認 = MsgBox(メッセージ & vbCrLf _
            & "実行してよろしいですか？", vbYesNo + vbQuestion)
      If 実行確認 = vbNo Then Exit Sub
    End If
    
  End If
  
  ''''''''''色設定処理''''''''''
  For Each セル In Selection
  
    On Error Resume Next
    If セル.Value <> "" Then
    
      '''''色判定'''''
      If IsNumeric(セル.Value) Then
      '数値の場合はRGB値と判断
        RGB値 = セル.Value
        
      ElseIf InStr(StrConv(セル.Value, vbLowerCase), "rgb(") = 1 Then
      '"rgb("で始まっている場合はRGB10進数と判断(大文字は小文字に変換)
        RGB配列 = RGB10進数文字toRGB10進数配列(セル.Value)
        RGB値 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
        
      ElseIf InStr(StrConv(セル.Value, vbLowerCase), "#") = 1 Then
      '"#"で始まっている場合はrrggbb16進数と判断
        RGB配列 = rrggbb16進数toRGB10進数配列(セル.Value)
        RGB値 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
        
      End If
      
      '''''色設定'''''
      If 色設定区分 = 1 Then
        セル.Interior.Color = RGB値
        
      ElseIf 色設定区分 = 2 Then
        セル.Font.Color = RGB値
        
      End If
      
    End If
    If Err.Number <> 0 Then
      セル.AddComment "エラー" & Err.Number & ":" & Err.Description
      On Error GoTo 0 'エラーオブジェクト初期化
    End If
    
  Next

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub 選択セルのカラーコードを固定変換()

  Const 確認メッセージフラグ = 1 '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const 色固定変換区分 = 6       '0:固定変換なし
                                 '1:RGB値→RGB10進数
                                 '2:RGB値→rrggbb16進数
                                 '3:RGB10進数→RGB値
                                 '4:RGB10進数→rrggbb16進数
                                 '5:rrggbb16進数→RGB値
                                 '6:rrggbb16進数→RGB10進数
  Const 色強制変換区分 = 0       '0:強制変換なし

  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードを変換(確認メッセージフラグ _
                                                                , 色固定変換区分 _
                                                                , 色強制変換区分)

End Sub

Sub 選択セルのカラーコードを強制変換()

  Const 確認メッセージフラグ = 1 '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const 色固定変換区分 = 0       '0:固定変換なし
  Const 色強制変換区分 = 3       '0:強制変換なし
                                 '1:RGB10進数またはrrggbb16進数→RGB値
                                 '2:RGB値またはrrggbb16進数→RGB10進数
                                 '3:RGB値またはRGB10進数→rrggbb16進数

  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードを変換(確認メッセージフラグ _
                                                                , 色固定変換区分 _
                                                                , 色強制変換区分)

End Sub

Sub RGB値またはRGB10進数またはrrggbb16進数のカラーコードを変換(確認メッセージフラグ As Integer _
                                                             , 色固定変換区分 As Integer _
                                                             , 色強制変換区分 As Integer)

  ''''''''''定義''''''''''
  Dim 実行確認 As Integer
  Dim メッセージ As String
  
  Dim 色変換WK As String
  Dim RGB配列 As Variant
  Dim 赤R, 緑G, 青B As Long
  Dim RGB変換値 As String
  Dim RGB値 As Long
  Dim RGB_10進数 As String
  Dim rrggbb_16進数 As String
  Dim セル As Range
  
  ''''''''''チェック''''''''''
  If Selection(1).Column < Selection(Selection.Count).Column Then
    MsgBox "右隣のセルに結果を設定するので1列で選択してください。"
    Exit Sub
  End If
  
  ''''''''''確認処理''''''''''
  If 確認メッセージフラグ = 1 Then
  
    If 色固定変換区分 = 1 Then
      色変換WK = "RGB→をRGB10進数"
      
    ElseIf 色固定変換区分 = 2 Then
      色変換WK = "RGB値→rrggbb16進数"
      
    ElseIf 色固定変換区分 = 3 Then
      色変換WK = "RGB10進数→RGB値"
      
    ElseIf 色固定変換区分 = 4 Then
      色変換WK = "RGB10進数→rrggbb16進数"
      
    ElseIf 色固定変換区分 = 5 Then
      色変換WK = "rrggbb16進数→RGB値"
      
    ElseIf 色固定変換区分 = 6 Then
      色変換WK = "rrggbb16進数→RGB10進数"
      
    End If
  
    If 色強制変換区分 = 1 Then
      色変換WK = "RGB10進数またはrrggbb16進数→RGB値"
      
    ElseIf 色強制変換区分 = 2 Then
      色変換WK = "RGB値またはrrggbb16進数→RGB10進数"
      
    ElseIf 色強制変換区分 = 3 Then
      色変換WK = "RGB値またはRGB10進数→rrggbb16進数"
      
    End If
    
    メッセージ = メッセージ _
      & "・" & 色変換WK & "に変換し、右隣のセルに設定します｡ " & vbCrLf _
      & "　既に値がセットされている場合は上書きされます。" & vbCrLf _
      & vbCrLf
      
    '実行確認
    If メッセージ <> "" Then
      実行確認 = MsgBox(メッセージ & vbCrLf _
            & "実行してよろしいですか？", vbYesNo + vbQuestion)
      If 実行確認 = vbNo Then Exit Sub
    End If
    
  End If
  
  ''''''''''色変換処理''''''''''
  For Each セル In Selection
  
    On Error Resume Next
    If セル.Value <> "" Then
    
      If IsNumeric(セル.Value) Then
      '数値の場合はRGB値と判断
        If 色固定変換区分 = 1 Or 色強制変換区分 = 2 Then
        'RGB→をRGB10進数
          RGB配列 = RGB値toRGB10進数配列(セル.Value)
          RGB変換値 = "rgb(" & RGB配列(0) & "," & RGB配列(1) & "," & RGB配列(2) & ")"
          
        ElseIf 色固定変換区分 = 2 Or 色強制変換区分 = 3 Then
        'RGB値→rrggbb16進数
          RGB配列 = RGB値toRGB10進数配列(セル.Value)
          RGB変換値 = "#" & Right(0 & hex(RGB配列(0)), 2) & _
                            Right(0 & hex(RGB配列(1)), 2) & _
                            Right(0 & hex(RGB配列(2)), 2)
                            
        End If
        
      ElseIf InStr(StrConv(セル.Value, vbLowerCase), "rgb(") = 1 Then
      '"rgb("で始まっている場合はRGB10進数と判断(大文字は小文字に変換)
        If 色固定変換区分 = 3 Or 色強制変換区分 = 1 Then
        'RGB10進数→RGB値
          RGB配列 = RGB10進数文字toRGB10進数配列(セル.Value)
          RGB変換値 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
          
        ElseIf 色固定変換区分 = 4 Or 色強制変換区分 = 3 Then
        'RGB10進数→rrggbb16進数
          RGB配列 = RGB10進数文字toRGB10進数配列(セル.Value)
          RGB変換値 = "#" & Right(0 & hex(RGB配列(0)), 2) & _
                            Right(0 & hex(RGB配列(1)), 2) & _
                            Right(0 & hex(RGB配列(2)), 2)
                            
        End If
        
      ElseIf InStr(StrConv(セル.Value, vbLowerCase), "#") = 1 Then
      '"#"で始まっている場合はrrggbb16進数と判断
        If 色固定変換区分 = 5 Or 色強制変換区分 = 1 Then
        'rrggbb16進数→RGB値
          RGB配列 = rrggbb16進数toRGB10進数配列(セル.Value)
          RGB変換値 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
          
        ElseIf 色固定変換区分 = 6 Or 色強制変換区分 = 2 Then
        'rrggbb16進数→RGB10進数
          RGB配列 = rrggbb16進数toRGB10進数配列(セル.Value)
          RGB変換値 = "rgb(" & RGB配列(0) & "," & RGB配列(1) & "," & RGB配列(2) & ")"
          
        End If
        
      End If
      セル.Offset(0, 1).Value = RGB変換値
      
    End If
    If Err.Number <> 0 Then
      セル.AddComment "エラー" & Err.Number & ":" & Err.Description
      On Error GoTo 0 'エラーオブジェクト初期化
    End If
    
  Next

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub 選択セルのカラーコードで背景色グラデーション設定()

  Const 確認メッセージフラグ = 1   '0:確認メッセージを表示しない、1:確認メッセージを表示する
  
  Call RGB値またはRGB10進数またはrrggbb16進数のカラーコードグラデーション設定(確認メッセージフラグ)

End Sub

Sub RGB値またはRGB10進数またはrrggbb16進数のカラーコードグラデーション設定(確認メッセージフラグ As Integer)

  Dim メッセージ As String
  Dim 実行確認 As String
  
  Dim 色設定WK As String
  Dim セル As Range
  Dim RGB配列 As Variant
  Dim RGB値1, RGB値2 As Long
  
  ''''''''''チェック''''''''''
  If Selection(Selection.Count).Column - Selection(1).Column + 1 <> 2 Then
    MsgBox "2色の組み合わせで右隣のセルにグラデーション設定するので2列で選択してください。"
    Exit Sub
  End If
  
  ''''''''''確認処理''''''''''
  If 確認メッセージフラグ = 1 Then
  
    メッセージ = メッセージ _
      & "・RGB値、10進数RGB、16進数#rrggbb、いずれかのカラーコードを２色取得し、" _
      & "セルの背景色にグラデーション設定します｡ " & vbCrLf _
      & "　既に背景色がセットされている場合は上書きされます。" & vbCrLf _
      & vbCrLf
      
    '実行確認
    If メッセージ <> "" Then
      実行確認 = MsgBox(メッセージ & vbCrLf _
            & "実行してよろしいですか？", vbYesNo + vbQuestion)
      If 実行確認 = vbNo Then Exit Sub
    End If
    
  End If
  
  ''''''''''色設定処理''''''''''
  For Each セル In Selection
  
    On Error Resume Next
    If セル.Value <> "" _
      And セル.Column = Selection(1).Column Then '選択1列目のみ(2列目はoffsetで)
      
      '''''色判定'''''
      '１色目
      If IsNumeric(セル.Value) Then
      '数値の場合はRGB値と判断
        RGB値1 = セル.Value
        
      ElseIf InStr(StrConv(セル.Value, vbLowerCase), "rgb(") = 1 Then
      '"rgb("で始まっている場合はRGB10進数と判断(大文字は小文字に変換)
        RGB配列 = RGB10進数文字toRGB10進数配列(セル.Value)
        RGB値1 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
        
      ElseIf InStr(StrConv(セル.Value, vbLowerCase), "#") = 1 Then
      '"#"で始まっている場合はrrggbb16進数と判断
        RGB配列 = rrggbb16進数toRGB10進数配列(セル.Value)
        RGB値1 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
        
      End If
      '２色目
      If IsNumeric(セル.Offset(0, 1).Value) Then
      '数値の場合はRGB値と判断
        RGB値2 = セル.Offset(0, 1).Value
        
      ElseIf InStr(StrConv(セル.Offset(0, 1).Value, vbLowerCase), "rgb(") = 1 Then
      '"rgb("で始まっている場合はRGB10進数と判断(大文字は小文字に変換)
        RGB配列 = RGB10進数文字toRGB10進数配列(セル.Offset(0, 1).Value)
        RGB値2 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
        
      ElseIf InStr(StrConv(セル.Offset(0, 1).Value, vbLowerCase), "#") = 1 Then
      '"#"で始まっている場合はrrggbb16進数と判断
        RGB配列 = rrggbb16進数toRGB10進数配列(セル.Offset(0, 1).Value)
        RGB値2 = RGB(RGB配列(0), RGB配列(1), RGB配列(2))
        
      End If
      
      '''''グラデーション色設定'''''
      With セル.Offset(0, 2).Interior
          .Pattern = xlPatternLinearGradient
          .Gradient.Degree = 90 '線形グラデーション（色が変化する角度を指定するために使用）
          .Gradient.ColorStops.Clear
      End With
      With セル.Offset(0, 2).Interior.Gradient.ColorStops.Add(0)
          .Color = RGB値1
          .TintAndShade = 0
      End With
      With セル.Offset(0, 2).Interior.Gradient.ColorStops.Add(1)
          .Color = RGB値2
          .TintAndShade = 0
      End With
      
    End If
    If Err.Number <> 0 Then
      セル.AddComment "エラー" & Err.Number & ":" & Err.Description
      On Error GoTo 0 'エラーオブジェクト初期化
    End If
    
  Next

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RGB値toRGB10進数配列(RGB値 As Long) As Long()

  Dim RGB配列(3) As Long
  
  RGB配列(0) = RGB値 Mod 256            '赤R
  RGB配列(1) = Int(RGB値 / 256) Mod 256 '緑G
  RGB配列(2) = Int(RGB値 / 256 / 256)   '青B
  RGB値toRGB10進数配列 = RGB配列

End Function

Function RGB10進数文字toRGB10進数配列(RGB値 As String) As String()

  Dim rgb値変換 As String
  Dim 開始位置, 終了位置 As Integer
  
  rgb値変換 = Replace(RGB値, " ", "")
  開始位置 = InStr(rgb値変換, "rgb(")
  終了位置 = InStr(開始位置 + 1, rgb値変換, ")")
  rgb値変換 = Mid(rgb値変換, 開始位置 + 4, 終了位置 - 開始位置 - 4)
  RGB10進数文字toRGB10進数配列 = Split(rgb値変換, ",")

End Function

Function rrggbb16進数toRGB10進数配列(rrggbb値) As Integer()

  Dim RGB配列(3) As Integer
  
  rrggbb値 = StrConv(rrggbb値, vbUpperCase) '大文字変換
  RGB配列(0) = rrggbb16進数toRGB10進数_1(Mid(rrggbb値, 2, 2)) '赤R
  RGB配列(1) = rrggbb16進数toRGB10進数_1(Mid(rrggbb値, 4, 2)) '緑G
  RGB配列(2) = rrggbb16進数toRGB10進数_1(Mid(rrggbb値, 6, 2)) '青B
  rrggbb16進数toRGB10進数配列 = RGB配列

End Function

Function rrggbb16進数toRGB10進数_1(ByRef hex As String) As Integer

  If Len(hex) <> 2 Then
    rrggbb16進数toRGB10進数_1 = -1
    Exit Function
  End If
  If (left(hex, 1) >= 0 And left(hex, 1) <= 9) Or _
    (left(hex, 1) >= "A" And left(hex, 1) <= "F") Then
  Else
    rrggbb16進数toRGB10進数_1 = -1
    Exit Function
  End If
  If (Right(hex, 1) >= 0 And Right(hex, 1) <= 9) Or _
    (Right(hex, 1) >= "A" And Right(hex, 1) <= "F") Then
  Else
    rrggbb16進数toRGB10進数_1 = -1
    Exit Function
  End If
  rrggbb16進数toRGB10進数_1 = rrggbb16進数toRGB10進数_2(left(hex, 1)) * 16 _
                              + rrggbb16進数toRGB10進数_2(Right(hex, 1))

End Function

Function rrggbb16進数toRGB10進数_2(ByRef hex As String) As Integer

  Select Case left(hex, 1)
    Case "A"
      rrggbb16進数toRGB10進数_2 = 10
    Case "B"
      rrggbb16進数toRGB10進数_2 = 11
    Case "C"
      rrggbb16進数toRGB10進数_2 = 12
    Case "D"
      rrggbb16進数toRGB10進数_2 = 13
    Case "E"
      rrggbb16進数toRGB10進数_2 = 14
    Case "F"
      rrggbb16進数toRGB10進数_2 = 15
    Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
      rrggbb16進数toRGB10進数_2 = CInt(hex)
    Case Else
      rrggbb16進数toRGB10進数_2 = -1
  End Select

End Function

実行方法

色取得は「選択セルの背景色のカラーコードを取得()」「選択セルの文字色のカラーコードを取得()」を実行してください。

色設定は「選択セルのカラーコードで背景色設定()」「選択セルのカラーコードで文字色設定()」を実行してください。

色変換は「選択セルのカラーコードを固定変換()」「選択セルのカラーコードを強制変換()」を実行してください。

グラデーション色設定は「選択セルのカラーコードで背景色グラデーション設定()」を実行してください。

目的に応じて設定変更してカスタマイズしてください。

最後に

Excelの使い方は人それぞれ、いろんなやり方があると思いますが、一例としてご紹介させていただきました。

ExcelVBAマクロはちょっとした向上心さえあれば、取っ付きやすいプログラムなのでショートカットキーなどと組み合わせてぜひ活用してみてください。

Excel全ショートカットキー一覧はこちら↓↓↓

【Excel】エクセルの全ショートカット集｜プルダウンメニューまで完全網羅

表計算ソフトとして王者であるExcel。たくさんの人が使っていると思います。まぁまぁ高額ではありますが、その分、高機能なので使い倒したいとは思いませんか？単に表データを扱うだけではなく、図を挿入できたり、設計書などのドキュメントとして使った...

caymezon.com

2019.04.01

ちょっと工夫すれば、ちょっとした操作に１分かかっていた作業を１０秒でこなすことができるようになる可能性があります。

それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。

The post 【ExcelVBA】背景色・文字色のカラーコード一覧｜取得・設定マクロで効率化 first appeared on CayTech Lab.

２つのデータの差分を一発で色付けしてわかりやすくしたい、そんな機能があったらきっと便利です。

そこで、２シートに比較したいデータを貼り付けし、超絶簡単に大量のデータを比較するVBAマクロを作成してみました。

データベースからデータを取得し、データを解析して差分を抽出したい時なんかは大いに役に立つと思います。

百聞は一見に如かず、一目瞭然、一発でイメージが湧き、使い方がわかるようなGIFアニメ付きです。

個人用マクロなどにコピーして実行するだけなので、ぜひお試しください。

データ差分比較抽出ツールについて

データ比較ツールとしてWinMergeなどの定番ソフトを使えば細かい比較ができます。

それで目的が満たされればよいですが、テキストなので解析がめんどくさいですね。

なかなかExcelでアドインとか使わずに手軽に思い通りに比較できる手段ってないですよね。

VLOOKUP関数や条件付き書式をいちいち使うのも結構大変です。

そこで、Excelで簡単に行、列、セル単位で一発で色で差分を確認できると便利かなぁと思ってマクロを作成してみました。

今回作ったマクロは以下２パターンの比較になります。

作成した比較処理の主なポイントは以下です。なるべくインターフェースを簡単にし、直感で操作できるように目指しました。詳細な仕様はソース上のコメントなどで補足してます。

隣り合わせに並べた２シートに比較データを設定

比較したいデータをそれぞれ２シートに分けて設定します。同じ位置関係で比較しやすくするためです。

プライマリーキーの入力指定有無で比較方法を判断

キー未入力で全行列セル比較、キー列指定でその列をユニークデータと判断して１行データありなしの比較を行います。

行と列のデータ数が全く同じ全データのセルの一致・不一致を差分比較

まずは行列の数が同じデータを２シートに設定して、単純にその値の差分を抽出したい場合に行う方法です。

２シートの行列セル全比較で色を付けて表示する操作イメージ

下記画像にて比較操作のイメージを沸かせてみてください。

テストデータを貼り付けて適当に値をいじって左右の違いを浮き彫りにしてます。

データ数が違う場合は事前にチェックで弾きます。

プライマリーキー列指定で１行の重複データの有無を含めて差分比較

次は行列の数が違っても同じでもよいデータを２シートに設定して、プライマリーキー（一意となる列）を指定して行ごとのデータありなしの違いを含めて差分を抽出したい場合に行う方法です。

２シートのプライマリーキー列指定比較で色を付けて表示する操作イメージ

下記画像にて比較操作のイメージを沸かせてみてください。

テストデータを貼り付けてプライマリーキー列の値をいじって左右の行列の違いを浮き彫りにしてます。

プライマリキーによる重複データは処理中にチェックで弾きます。

左右2シートデータ照合キー差分比較VBAマクロの主な仕様

細かい処理はコメントで補足してますが、ザックリとした仕様を箇条書きで記載します。

左右2シートデータ照合キー差分比較VBAマクロのソースコード

差分比較でデータ解析効率を爆上げしたい方は、下記のソースコードを以下↓↓↓のリンクの内容に従って個人用マクロにコピーしてご使用ください。

【Excel】超便利な個人用マクロブックにVBAを記録追加作成して実行【初心者も簡単】

仕事や勉強を行う上で、Excelを使用するならば、絶対に知っておいた方がよい「個人用マクロブックの設定方法」をまとめました。マクロを頻繁に使用する人、今まで「作業中のブック」のみに個別設定していた人は、自分の作業に合った共通処理のマクロを「...

caymezon.com

2019.03.10

マクロならば、痒いところに手が届きます。用途によっては目的に沿わない可能性がありますが、Const値を持たせてなるべく汎用的に作成しています。

自分に合った方法にカスタマイズしてみてください。VBAマクロの勉強にも少しは役立つと思います。

結果的に割と複雑な処理になってしまったので、もし何かバグっていたらごめんなさい。気付いたら改修します。

Sub 左右2シートデータ照合キー差分比較()

  Const 確認メッセージフラグ = 1   '0:確認メッセージを表示しない、1:確認メッセージを表示する
  Const タイトル有無フラグ = 1     '0:タイトルなし、1:タイトルあり
  Const 結果シートマージフラグ = 1 '0:マージしない、1:マージする
  
  Call 左右2シートデータ照合キー差分比較処理(確認メッセージフラグ _
                                       , タイトル有無フラグ _
                                       , 結果シートマージフラグ)
                                  
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub 左右2シートデータ照合キー差分比較処理(確認メッセージフラグ As Integer _
                                    , タイトル有無フラグ As Integer _
                                    , 結果シートマージフラグ As Integer)
                                      
  ''''''''''概要''''''''''
  '・左右２シートをデータ照合比較し、差分の行やセルに色を付ける。
  '・比較方法は「行列セル全比較」と「プライマリーキー列指定比較」の２パターン。
  '・元シートを比較用にコピーして処理する。（元シートは一切いじらないので繰り返し可能）
  '・比較処理に必要なチェックを実施する。（範囲チェック、重複チェックなど）
  
  ''''''''''前提''''''''''
  '・比較対象２シートの左側シートがアクティブの状態で実行。
  '・プライマリーキーは数字か英字のみで指定。（複数の場合はカンマ区切り）
  '・セル全比較の場合は左右シート両方共、行と列が同じである必要がある。
  '・プライマリーキー列指定比較の場合はそのキーで一意になっている必要がある。
  '　（一意になっていない場合はエラーとし、処理途中で強制終了）
  '・シートを非表示にした状態での実行は非推奨（わけわからなくなる可能性あり）
  '・セルの表示形式は全セル「文字列」推奨。
  '・数式は非推奨（未検証）。※正常に動作するかもしれないが、しないかもしれない。
  
  ''''''''''定義''''''''''
  Dim 実行確認 As Integer
  Dim メッセージ As String
  
  Dim 比較処理区分 As Integer
  '1:データ数が全く同じ前提で行列セル全比較、2:プライマリーキー列指定で比較
  
  '元シート
  Dim 左シート, 右シート As Object '元シート
  Dim 左データ範囲, 右データ範囲 As Range '比較データ範囲
  Dim 左シート番号, 右シート番号  As Integer '左右シート番号
  Dim 左シート名, 右シート名 As String '左右シート名
  
  '比較シート
  Dim 左比較シート, 右比較シート As Object '比較用コピーシート
  Dim 左比較シート番号, 右比較シート番号 As Integer 'コピー後のシート番号
  Dim 左比較シート名, 右比較シート名 As String 'コピー後のシート名
  Dim 現在時刻 As String 'コピー後シート名をユニークにするための時刻
  
  '行列編集
  Dim 左現在行, 右現在行 As Long
  Dim 左キー列, 右キー列 As Range
  Dim 左開始行, 右開始行, 左開始列, 右開始列 As Long
  Dim 左最終行, 右最終行, 左最終列, 右最終列 As Long
  Dim 比較開始行, 比較開始列, 比較最終行, 比較列数 As Long
  Dim 比較最終列 As Long '※１
  Dim 比較対象行, 比較対象列 As Long '値比較時ワーク
  Dim 左キー列セル範囲, 右キー列セル範囲 As Range 'キー列のセル範囲
  Dim ソート開始行, 列位置追加行 As Long
  Dim 差分列, キー列, 追加列数 As Integer '編集列
  
  'キー列編集
  Dim 左キー, 右キー, キー値 As String 'ユニークとなるキー値
  Dim キー列入力値, キー列数字編集値, キー列英字編集値 As String 'キー配列編集値
  Dim キー列変換 As String
  Dim 入力キー数字列 As Long '※１
  Dim 入力キー英字列 As String '※１
  Dim キー列番号配列 As Variant 'プライマリーキー配列
  Dim 左キー重複フラグ, 右キー重複フラグ As Boolean
  Dim キー列ワーク配列() As Integer
  Dim 左差分セル, 右差分セル, 左比較セル, 右比較セル As Range '各比較セル範囲
  
  'カウンタ
  Dim i As Long '※１
  Dim j As Long
  
  '※１：「ByRef引数の型が一致しません。」回避のため単一定義
  
  ''''''''''高速化''''''''''
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  
  ''''''''''初期処理''''''''''
  '比較シート設定
  左シート番号 = ActiveSheet.index '現在のアクティブシートを基点にIndex決定
  If 左シート番号 = Worksheets.Count Then
    MsgBox "比較対象の左側を現在シートにして実行してください。（右隣りシートあり前提）" & vbCrLf _
         & "処理を終了します。"
    Exit Sub
  End If
  右シート番号 = 左シート番号 + 1
  左シート名 = Sheets(左シート番号).name
  右シート名 = Sheets(右シート番号).name
  Set 左シート = Sheets(左シート名)
  Set 右シート = Sheets(右シート名)
  
  '比較対象データ範囲
  Set 左データ範囲 = 左シート.UsedRange
  ':上下
  左開始行 = 左データ範囲.Row
  左最終行 = 左データ範囲.Row + 左データ範囲.Rows.Count - 1
  ':左右
  左開始列 = 左データ範囲.Column
  左最終列 = 左データ範囲.Column + 左データ範囲.Columns.Count - 1
  Set 右データ範囲 = 右シート.UsedRange
  ':上下
  右開始行 = 右データ範囲.Row
  右最終行 = 右データ範囲.Row + 右データ範囲.Rows.Count - 1
  ':右右
  右開始列 = 右データ範囲.Column
  右最終列 = 右データ範囲.Column + 右データ範囲.Columns.Count - 1
  
  ''''''''''チェック''''''''''
  '''''開始行チェック'''''
  '開始行が左右で同じか
  If 左開始行 <> 右開始行 Then
    MsgBox "「" & 左シート名 & "」シートと「" & 右シート名 & "」シートの開始行が違います。" _
         & "合わせてください。" & vbCrLf _
         & "処理を終了します。"
    Exit Sub
  Else
    比較開始行 = 左開始行 '比較を開始する行を確定
  End If
  
  '''''開始列チェック'''''
  '1列目(A列)から設定しているか
  If 左開始列 <> 1 Or 右開始列 <> 1 Then
    MsgBox "「" & 左シート名 & "」シートと「" & 右シート名 & "」シート共に" _
         & "1列目(A列)から比較データを設定してください。" & vbCrLf _
         & "処理を終了します。"
    Exit Sub
  Else
    比較開始列 = 左開始列 '比較を開始する行を確定
  End If
  
  '''''最終列チェック'''''
  '最終列が左右で同じか
  If 左最終列 <> 右最終列 Then
    右シート.Activate
    右データ範囲.Select
    左シート.Activate
    左データ範囲.Select
    MsgBox "「" & 左シート名 & "」シートと「" & 右シート名 & "」シートのデータ最終列が違います。" _
         & "合わせてください。" & vbCrLf _
         & "処理を終了します。"
    Exit Sub
  Else
    比較最終列 = 左最終列
    比較列数 = 比較最終列 - 比較開始列 + 1
  End If
  
  '''''キー列入力'''''
  キー列入力値 = Application.InputBox( _
                     "未入力：行列セル全比較" & vbCrLf _
                      & "列番号指定(カンマ区切り)：プライマリーキー比較" _
                     , Type:=2 _
                     , Default:="")
                     
  If キー列入力値 = "" Then
    比較処理区分 = 1 'キー入力なしの場合は行列セル全比較
    
    '全列取得
    ReDim キー列ワーク配列(比較列数)
    For i = 1 To 比較列数
      キー列入力値 = キー列入力値 & i & ","
      キー列ワーク配列(i) = i
    Next
    'キー列入力値 = left(キー列入力値, InStrRev(キー列入力値, ",") - 1) '最後のカンマをカット
    キー列入力値 = "1-" & 比較列数
    キー列英字編集値 = "A-" & A1式変換(比較列数) '数字→英字(1→A)変換
    キー列番号配列 = キー列ワーク配列
    
  ElseIf キー列入力値 = False Then
    Exit Sub 'Escキャンセルの場合は終了
    
  ElseIf キー列入力値 <> "" Then
    比較処理区分 = 2 'キー入力ありの場合はプライマリーキー列指定比較
    
    'キー入力値取得（全角変換、半角スペース除去）
    キー列番号配列 = Split(Replace(StrConv(キー列入力値, vbNarrow), " ", ""), ",")
    ReDim キー列ワーク配列(UBound(キー列番号配列))
    
    'キー列入力値編集
    For i = LBound(キー列番号配列) To UBound(キー列番号配列)
    
      If Not キー列番号配列(i) Like "*[!0-9]*" Then '数字のみかチェック
        入力キー数字列 = キー列番号配列(i)
        入力キー英字列 = A1式変換(入力キー数字列) '数字→英字(1→A)変換
        キー列数字編集値 = キー列数字編集値 & 入力キー数字列 & ","
        キー列英字編集値 = キー列英字編集値 & 入力キー英字列 & ","
        
      ElseIf Not キー列番号配列(i) Like "*[!a-zA-Z]*" Then '英字のみかチェック
        入力キー英字列 = キー列番号配列(i)
        入力キー数字列 = R1C1式変換(入力キー英字列) '英字→数字(A→1)変換
        キー列数字編集値 = キー列数字編集値 & 入力キー数字列 & ","
        キー列英字編集値 = キー列英字編集値 & 入力キー英字列 & ","
        
      Else
        MsgBox "キー列を数字または英字で入力してください。" & vbCrLf _
           & "処理を終了します。"
        Exit Sub
        
      End If
      
      'キー入力チェック
      '入力した列がデータ範囲を超えていないか
      If 比較最終列 < 入力キー数字列 Then
        MsgBox "入力キー列「" & A1式変換(入力キー数字列) & "列(" & 入力キー数字列 & ")」が" _
          & "データ範囲の最終列「" & A1式変換(比較最終列) & "列(" & 比較最終列 & ")」を" _
          & "超えてます。" & vbCrLf _
          & "処理を終了します。"
        Exit Sub
      End If
      
    Next
    キー列数字編集値 = left(キー列数字編集値, InStrRev(キー列数字編集値, ",") - 1) '最後のカンマをカット
    キー列英字編集値 = left(キー列英字編集値, InStrRev(キー列英字編集値, ",") - 1) '最後のカンマをカット
    キー列入力値 = キー列数字編集値
    キー列番号配列 = Split(キー列入力値, ",")
    
  End If
  
  '''''最終行チェック'''''
  '最終行が左右で同じか（行列セル全比較のみ）
  If 比較処理区分 = 1 Then
    If 左最終行 <> 右最終行 Then
      MsgBox "「" & 左シート名 & "」シートと「" & 右シート名 & "」シートのデータ行の数が違います。" _
           & "合わせてください。" & vbCrLf _
           & "（行列データ数が全く同じ前提で比較します）" & vbCrLf _
           & "処理を終了します。"
      Exit Sub
    Else
      比較最終行 = 左最終行
    End If
  End If
  
  ''''''''''確認処理''''''''''
  If 確認メッセージフラグ = 1 Then
  
    If 比較処理区分 = 1 Then '行列セル全比較の場合
      メッセージ = メッセージ _
        & "・行列データ数が全く同じ前提で、行列セル全データを比較します。" & vbCrLf _
        & vbCrLf
        
    ElseIf 比較処理区分 = 2 Then 'プライマリーキー列指定比較の場合
      メッセージ = メッセージ _
        & "・プライマリーキー列でソートし、左右データ存在チェックを含めて比較します。" & vbCrLf
      If タイトル有無フラグ = 1 Then
        メッセージ = メッセージ _
          & "（データ開始行をタイトル行として比較します。タイトル行はソート対象外です。）" & vbCrLf _
          & vbCrLf
      Else
        メッセージ = メッセージ _
          & "（全データ行を全てキーでソートして比較します。）" & vbCrLf _
          & vbCrLf
      End If
      
    End If
    
    メッセージ = メッセージ _
      & "・「" & 左シート名 & "」シート(" & 左最終行 & "行目まで)と" _
      & "「" & 右シート名 & "」シート(" & 右最終行 & "行目まで)を" & vbCrLf _
      & "　データ比較します。" & vbCrLf _
      & "・「A列(1)～「" & A1式変換(比較最終列) & "列(" & 比較最終列 & ")」を比較対象とします。" & vbCrLf _
      & "・比較用に左右それぞれコピーして新規シートで比較します。" & vbCrLf _
      & "・「" & キー列入力値 & "」列目、「" & キー列英字編集値 & "」列のデータをキー値として" & vbCrLf _
      & "　データ比較します。" & vbCrLf
      
    '実行確認
    If メッセージ <> "" Then
      実行確認 = MsgBox(メッセージ & vbCrLf _
            & "実行してよろしいですか？", vbYesNo + vbQuestion)
      If 実行確認 = vbNo Then Exit Sub
    End If
    
  End If
  
  ''''''''''比較用シートコピー''''''''''
  左比較シート番号 = 右シート番号 + 1
  右比較シート番号 = 左比較シート番号 + 1
  現在時刻 = Format(Now, "hhnnss") '現在時刻（時分秒）
  
  '比較対象左側シートをコピーして比較編集対象とする
  左シート.Copy After:=Sheets(左シート番号 + 1)
  'シート名が24文字以下だったら"_hhnnss"(7文字)を付加
  If Len(左シート名) <= 24 Then
    左比較シート名 = 左シート名 + "_" + 現在時刻
  Else
    左比較シート名 = left(左シート名, 24) + "_" + 現在時刻
  End If
  Sheets(左比較シート番号).name = 左比較シート名
  
  Set 左比較シート = Sheets(左比較シート名)
  左比較シート.Tab.Color = RGB(255, 153, 204) '38:ローズ
  
  '比較対象右側シートをコピーして比較編集対象とする
  Sheets(右シート番号).Copy After:=Sheets(右シート番号 + 1)
  If Len(左シート名) <= 24 Then
    右比較シート名 = 右シート名 + "_" + 現在時刻
  Else
    右比較シート名 = Sheets(右シート番号).name + "_" + 現在時刻
  End If
  Sheets(右比較シート番号).name = 右比較シート名
  
  Set 右比較シート = Sheets(右比較シート名)
  右比較シート.Tab.Color = RGB(0, 204, 255) '33:スカイブルー
  
  ''''''''''左比較シートと右比較シートに編集列挿入''''''''''
  差分列 = 1 '１列目固定
  キー列 = 2 '２列目固定
  追加列数 = 2
  左比較シート.Columns(差分列).Insert ' 差分列挿入
  右比較シート.Columns(差分列).Insert ' 差分列挿入
  左比較シート.Columns(キー列).Insert ' キー列挿入
  右比較シート.Columns(キー列).Insert ' キー列挿入
  
  ''''''''''左比較シートと右比較シートにキー値セット''''''''''
  '''''左比較シート'''''
  左比較シート.Activate
  Set 左キー列セル範囲 = Range(cells(比較開始行, キー列), cells(左最終行, キー列))
  For Each 左キー列 In 左キー列セル範囲
    左キー = ""
    For i = LBound(キー列番号配列) To UBound(キー列番号配列)
      キー値 = cells(左キー列.Row, 追加列数 + キー列番号配列(i)).Text '表示上の値を比較するのでText取得
      左キー = 左キー & キー値
    Next
    If 左キー = "" Then 左キー = "null" '空文字の扱いはめんどくさいので"null"にしておく
    cells(左キー列.Row, キー列).Value = 左キー
    cells(左キー列.Row, キー列).Font.Bold = True '太字
    cells(左キー列.Row, キー列).Font.Underline = True '下線
  Next
  
  '''''右比較シート'''''
  右比較シート.Activate
  Set 右キー列セル範囲 = Range(cells(比較開始行, キー列), cells(右最終行, キー列))
  For Each 右キー列 In 右キー列セル範囲
    右キー = ""
    For i = LBound(キー列番号配列) To UBound(キー列番号配列)
      キー値 = cells(右キー列.Row, 追加列数 + キー列番号配列(i)).Text '表示上の値を比較するのでText取得
      右キー = 右キー & キー値
    Next
    If 右キー = "" Then 右キー = "null" '空文字の扱いはめんどくさいので"null"にしておく
    cells(右キー列.Row, キー列).Value = 右キー
    cells(右キー列.Row, キー列).Font.Bold = True '太字
    cells(右キー列.Row, キー列).Font.Underline = True '下線
    
  Next
  
  If 比較処理区分 = 1 Then
  'データ数が全く同じ前提で行列セル全比較
  
    左比較シート.Activate
    左現在行 = 比較開始行 '左開始データ行
    右現在行 = 比較開始行 '右開始データ行
    左キー = 左比較シート.cells(左現在行, キー列).Value
    右キー = 右比較シート.cells(右現在行, キー列).Value
    
    Do Until 左キー = "" And 右キー = "" '左キーと右キーが両方共、ブランクになった場合終了
      
      '行の照合（１行ずつキー値で全行を照合）
      If 左キー = 右キー Then
        '左比較シートのキーと右比較シートのキーが一致の場合
        左比較シート.cells(左現在行, 差分列).Value = "一致"
        右比較シート.cells(右現在行, 差分列).Value = "一致"
        左比較シート.cells(左現在行, 差分列).Font.Color = RGB(0, 128, 0) '10:緑
        右比較シート.cells(右現在行, 差分列).Font.Color = RGB(0, 128, 0) '10:緑
      Else
        '左比較シートのキーと右比較シートのキーが不一致の場合
        左比較シート.cells(左現在行, 差分列).Value = "不一致"
        右比較シート.cells(右現在行, 差分列).Value = "不一致"
        左比較シート.cells(左現在行, 差分列).Font.Color = RGB(153, 204, 0) '43:ライム
        右比較シート.cells(右現在行, 差分列).Font.Color = RGB(153, 204, 0) '43:ライム
      End If
      
      '行カウント
      左現在行 = 左現在行 + 1
      右現在行 = 右現在行 + 1
      
      '次のキー値
      左キー = 左比較シート.cells(左現在行, キー列).Value
      右キー = 右比較シート.cells(右現在行, キー列).Value
      
    Loop
    
  ElseIf 比較処理区分 = 2 Then
  'プライマリーキー列指定で比較
  
    ''''''''''左比較シートと右比較シートをソート''''''''''
    If タイトル有無フラグ = 1 Then
      ソート開始行 = 比較開始行 + 1
    Else
      ソート開始行 = 比較開始行
    End If
    '''''左比較シート'''''
    左比較シート.Activate
    左比較シート.Range(cells(ソート開始行, キー列), cells(左最終行, キー列 + 左最終列)).Sort _
      Key1:=Columns(キー列), Order1:=xlAscending, Header:=xlNo
    '''''右比較シート'''''
    右比較シート.Activate
    右比較シート.Range(cells(ソート開始行, キー列), cells(右最終行, キー列 + 右最終列)).Sort _
      Key1:=Columns(キー列), Order1:=xlAscending, Header:=xlNo
    
    ''''''''''左比較シートと右比較シートのソート後データチェック''''''''''
    '''''左比較シート'''''
    左比較シート.Activate
    Set 左キー列セル範囲 = Range(cells(比較開始行, キー列), cells(左最終行, キー列))
    For Each 左キー列 In 左キー列セル範囲
      左キー = cells(左キー列.Row, キー列).Value
      If 左キー = cells(左キー列.Row, キー列).Offset(1, 0).Value Then
        左キー重複フラグ = True
        Exit For
      End If
    Next
    If 左キー重複フラグ Then
      cells(左キー列.Row, キー列).Interior.Color = RGB(255, 0, 0) '3:赤
      cells(左キー列.Row, キー列).Offset(1, 0).Interior.Color = RGB(255, 0, 0) '3:赤
      cells(左キー列.Row, キー列).Select
      MsgBox "「" & 左シート名 & "」シートのキー列「" & キー列入力値 & "」データ、" _
            & 左キー列.Row & "行目の値「" & 左キー & "」で重複してます。" & vbCrLf _
            & "途中ですが、処理を終了します。" & vbCrLf _
            & "キー比較はできませんので設定データを見直してください。"
      Exit Sub
    End If
    '''''右比較シート'''''
    右比較シート.Activate
    Set 右キー列セル範囲 = Range(cells(比較開始行, キー列), cells(右最終行, キー列))
    For Each 右キー列 In 右キー列セル範囲
      右キー = cells(右キー列.Row, キー列).Value
      If 右キー = cells(右キー列.Row, キー列).Offset(1, 0).Value Then
        右キー重複フラグ = True
        Exit For
      End If
    Next
    If 右キー重複フラグ Then
      cells(右キー列.Row, キー列).Interior.Color = RGB(255, 0, 0) '3:赤
      cells(右キー列.Row, キー列).Offset(1, 0).Interior.Color = RGB(255, 0, 0) '3:赤
      cells(右キー列.Row, キー列).Select
      MsgBox "「" & 右シート名 & "」シートのキー列「" & キー列入力値 & "」データ、" _
            & 右キー列.Row & "行目の値「" & 右キー & "」で重複してます。" & vbCrLf _
            & "途中ですが、処理を終了します。" & vbCrLf _
            & "キー比較はできませんので設定データを見直してください。"
      Exit Sub
    End If
    
    ''''''''''左比較シートと右比較シートをキー値で照合''''''''''
    左比較シート.Activate
    If タイトル有無フラグ = 1 Then 'タイトルありの場合は２行目から
      左現在行 = 比較開始行 + 1
      右現在行 = 比較開始行 + 1
    Else
      左現在行 = 比較開始行
      右現在行 = 比較開始行
    End If
    左キー = 左比較シート.cells(左現在行, キー列).Value
    右キー = 右比較シート.cells(右現在行, キー列).Value
    
    Do Until 左キー = "" And 右キー = "" '左キーと右キーが両方共、ブランクになった場合終了
      
      '行の照合（１行ずつキー値で照合して足りない場合は行挿入）
      If 左キー = 右キー Then
        '左比較シートのキーと右比較シートのキーが一致した場合
        左比較シート.cells(左現在行, 差分列).Value = "一致"
        右比較シート.cells(右現在行, 差分列).Value = "一致"
        左比較シート.cells(左現在行, 差分列).Font.Color = RGB(0, 128, 0) '10:緑
        右比較シート.cells(右現在行, 差分列).Font.Color = RGB(0, 128, 0) '10:緑
      ElseIf 左キー > 右キー Then
        If 右キー <> "" Then
          '左比較シートのキーの方が右比較シートのキーより大きい場合
          左比較シート.Rows(左現在行).Insert
          左比較シート.cells(左現在行, 差分列).Value = "なし"
          左比較シート.cells(右現在行, キー列).Value = 右キー
          左比較シート.cells(左現在行, 差分列).Font.Color = RGB(255, 0, 0) '3:赤
          右比較シート.cells(右現在行, 差分列).Value = "あり"
          右比較シート.cells(右現在行, 差分列).Font.Color = RGB(0, 0, 255) '5:青
        Else
          '左比較シートのキーがまだあるにも関わらず、右比較シートのキーが最後まで到達した場合
          右比較シート.Rows(右現在行).Insert
          右比較シート.cells(右現在行, 差分列).Value = "なし"
          右比較シート.cells(右現在行, キー列).Value = 左キー
          右比較シート.cells(右現在行, 差分列).Font.Color = RGB(255, 0, 0) '3:赤
          左比較シート.cells(左現在行, 差分列).Value = "あり"
          左比較シート.cells(左現在行, 差分列).Font.Color = RGB(0, 0, 255) '5:青
        End If
      ElseIf 左キー < 右キー Then
        If 左キー <> "" Then
          '右比較シートのキーの方が左比較シートのキーより大きい場合
          右比較シート.Rows(右現在行).Insert
          右比較シート.cells(右現在行, 差分列).Value = "なし"
          右比較シート.cells(右現在行, キー列).Value = 左キー
          右比較シート.cells(右現在行, 差分列).Font.Color = RGB(255, 0, 0) '3:赤
          左比較シート.cells(左現在行, 差分列).Value = "あり"
          左比較シート.cells(左現在行, 差分列).Font.Color = RGB(0, 0, 255) '5:青
        Else
          '右比較シートのキーがまだあるにも関わらず、左比較シートのキーが最後まで到達した場合
          左比較シート.Rows(左現在行).Insert
          左比較シート.cells(左現在行, 差分列).Value = "なし"
          左比較シート.cells(右現在行, キー列).Value = 右キー
          左比較シート.cells(左現在行, 差分列).Font.Color = RGB(255, 0, 0) '3:赤
          右比較シート.cells(右現在行, 差分列).Value = "あり"
          右比較シート.cells(右現在行, 差分列).Font.Color = RGB(0, 0, 255) '5:青
        End If
      End If
  
      '行カウント
      左現在行 = 左現在行 + 1
      右現在行 = 右現在行 + 1
      
      '次のキー値
      左キー = 左比較シート.cells(左現在行, キー列).Value
      右キー = 右比較シート.cells(右現在行, キー列).Value
      
    Loop
    
  End If
  
  '値比較　※データ照合済（行数の同期が取れている）前提
  比較最終行 = 左比較シート.cells(Rows.Count, 差分列).End(xlUp).Row
  For 比較対象行 = 比較開始行 To 比較最終行
    For 比較対象列 = 追加列数 + 比較開始列 To 追加列数 + 比較最終列  '差分列＋キー列を含む
    
      Set 左差分セル = 左比較シート.cells(比較対象行, 差分列)
      Set 右差分セル = 右比較シート.cells(比較対象行, 差分列)
      Set 左比較セル = 左比較シート.cells(比較対象行, 比較対象列)
      Set 右比較セル = 右比較シート.cells(比較対象行, 比較対象列)
      If 左差分セル.Value = "なし" And 右差分セル.Value = "あり" Then
        
        '左比較シートが「不足」で右比較シートが「追加」の場合
        左比較セル.Interior.Color = RGB(255, 153, 204) '38:ローズ
        右比較セル.Interior.Color = RGB(0, 204, 255) '33:スカイブルー
        
      ElseIf 左差分セル.Value = "あり" And 右差分セル.Value = "なし" Then
        
        '左比較シートが「追加」で右比較シートが「不足」の場合
        左比較セル.Interior.Color = RGB(0, 204, 255) '33:スカイブルー
        右比較セル.Interior.Color = RGB(255, 153, 204) '38:ローズ
        
      Else
      
        '左右比較シートが不一致の場合
        If 左比較セル.Text <> 右比較セル.Text Then
        
          '同じ位置のセルの値が等しくなければ、そのセルを色付け。
          左比較セル.Interior.Color = RGB(255, 255, 153) '36:薄い黄
          右比較セル.Interior.Color = RGB(255, 255, 153) '36:薄い黄
          '差分を不一致に書き換え
          左差分セル.Value = "不一致"
          左差分セル.Font.Color = RGB(153, 204, 0) '43:ライム
          右差分セル.Value = "不一致"
          右差分セル.Font.Color = RGB(153, 204, 0) '43:ライム
          
        Else
          '同じ位置のセルの値が等しければ、何もしない
        End If
        
      End If
      
    Next
  Next
  
  ''''''''''追加編集''''''''''
  
  '''''追加列編集'''''
  左比較シート.Range(左比較シート.cells(比較開始行, 差分列), 左比較シート.cells(比較最終行, 差分列)) _
              .Borders(xlEdgeRight).LineStyle = xlContinuous '右罫線追加
  右比較シート.Range(右比較シート.cells(比較開始行, 差分列), 右比較シート.cells(比較最終行, 差分列)) _
              .Borders(xlEdgeRight).LineStyle = xlContinuous '右罫線追加
  
  '''''追加行編集'''''
  '元のシートの列情報を追加するために比較データの１つ上に１行追加
  左比較シート.Rows(比較開始行).Insert
  右比較シート.Rows(比較開始行).Insert
  
  '列情報を追加（キー列は下線と太字付加）
  列位置追加行 = 比較開始行
  For i = 1 To 比較列数
    If Application.ReferenceStyle = xlA1 Then
      'A1式の場合
      キー列変換 = A1式変換(i)
    Else
      'R1C1式の場合
      キー列変換 = i
    End If
    左比較シート.cells(列位置追加行, 追加列数 + i).Value = キー列変換
    右比較シート.cells(列位置追加行, 追加列数 + i).Value = キー列変換
    For j = LBound(キー列番号配列) To UBound(キー列番号配列)
      If i = キー列番号配列(j) Then
        With 左比較シート.cells(列位置追加行, 追加列数 + i).Font
          '.Underline = True '下線
          .Bold = True '太字
        End With
        With 右比較シート.cells(列位置追加行, 追加列数 + i).Font
          '.Underline = True '下線
          .Bold = True '太字
        End With
        Exit For
      End If
    Next
  Next

  '''''その他編集'''''
  '枠線やシート名設定など
  左比較シート.Activate
  With Range(cells(列位置追加行, 比較開始列 + 追加列数), cells(列位置追加行, 比較最終列 + 追加列数))
    .Borders(xlEdgeBottom).LineStyle = xlContinuous '下罫線追加
    .Interior.Color = RGB(255, 153, 204) '38:ローズ
    .HorizontalAlignment = xlCenter '横位置を中央揃え
  End With
  With cells(列位置追加行, 差分列)
    .Value = 左シート名
    .Font.Bold = True '太字
  End With
  '行フィルタとウィンドウ枠を固定
  If タイトル有無フラグ = 1 Then
    Range(cells(列位置追加行 + 1, 差分列), cells(列位置追加行 + 1, 比較最終列 + 追加列数)).AutoFilter
    Rows(列位置追加行 + 2).Select
  Else
    Range(cells(列位置追加行, 差分列), cells(列位置追加行, 比較最終列 + 追加列数)).AutoFilter
    Rows(列位置追加行 + 1).Select
  End If
  ActiveWindow.FreezePanes = True 'ウィンドウ枠を固定
  
  右比較シート.Activate
  With Range(cells(列位置追加行, 比較開始列 + 追加列数), cells(列位置追加行, 比較最終列 + 追加列数))
    .Borders(xlEdgeBottom).LineStyle = xlContinuous '下罫線追加
    .Interior.Color = RGB(0, 204, 255) '33:スカイブルー
    .HorizontalAlignment = xlCenter '横位置を中央揃え
  End With
  With cells(列位置追加行, 差分列)
    .Value = 右シート名
    .Font.Bold = True '太字
  End With
  '行フィルタとウィンドウ枠を固定
  If タイトル有無フラグ = 1 Then
    Range(cells(列位置追加行 + 1, 差分列), cells(列位置追加行 + 1, 比較最終列 + 追加列数)).AutoFilter
    Rows(列位置追加行 + 2).Select
  Else
    Range(cells(列位置追加行, 差分列), cells(列位置追加行, 比較最終列 + 追加列数)).AutoFilter
    Rows(列位置追加行 + 1).Select
  End If
  ActiveWindow.FreezePanes = True 'ウィンドウ枠を固定
  
  'キー列は最後に削除（何かバグってたらまずはコレをコメントアウト）
  左比較シート.Columns(キー列).Delete
  右比較シート.Columns(キー列).Delete
  
  'セル選択
  右比較シート.Activate
  右比較シート.Range("A1").Select
  左比較シート.Activate
  左比較シート.Range("A1").Select
  
  '''''結果マージ'''''
  '左右の比較結果を１シートにマージ
  If 結果シートマージフラグ Then
  
    '右シートの結果を左シートにコピー
    右比較シート.Range(右比較シート.Columns(1), 右比較シート.Columns(比較最終列 + 1)).Copy
    左比較シート.Paste Destination:=左比較シート.Columns(比較最終列 + 2)
    Application.CutCopyMode = False
    
    左比較シート.Activate
    Range(cells(列位置追加行, 比較最終列 + 1), cells(比較最終行 + 1, 比較最終列 + 1)) _
      .Borders(xlEdgeRight).LineStyle = xlDouble '右罫線追加(二重線)
      
    '行フィルタを一旦解除して再設定
    If タイトル有無フラグ = 1 Then
      Range(cells(列位置追加行 + 1, 差分列), cells(列位置追加行 + 1, 比較最終列 + 1)).AutoFilter
      Range(cells(列位置追加行 + 1, 差分列), cells(列位置追加行 + 1, (比較最終列 + 1) * 2)).AutoFilter
    Else
      Range(cells(列位置追加行, 差分列), cells(列位置追加行, 比較最終列 + 1)).AutoFilter
      Range(cells(列位置追加行, 差分列), cells(列位置追加行, (比較最終列 + 1) * 2)).AutoFilter
    End If
    
    'シート名が24文字以下だったら"_hhnnss"(7文字)を付加
    If Len(左シート名 & "_" & 右シート名) <= 24 Then
      左比較シート名 = 左シート名 & "_" & 右シート名 + "_" + 現在時刻
    Else
      左比較シート名 = left(左シート名 & "_" & 右シート名, 24) + "_" + 現在時刻
    End If
    Sheets(左比較シート番号).name = 左比較シート名
    左比較シート.Tab.Color = RGB(153, 204, 0) '43:ライム
    
    'シート削除
    Application.DisplayAlerts = False
    右比較シート.Delete
    Application.DisplayAlerts = True
    
    'セル選択
    左比較シート.Activate
    左比較シート.Range("A1").Select
    
  End If
  
  '高速化対応
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function A1式変換(col As Long) As String
    If col <= 0 Then
      A1式変換 = ""
    ElseIf col <= 26 Then
      A1式変換 = Chr(65 + ((col - 1) Mod 26))
    ElseIf col <= 26 * 27 Then
      A1式変換 = Chr(65 + ((col - 27) \ 26) Mod 26) & _
                 Chr(65 + ((col - 1) Mod 26))
    ElseIf col <= 26 * 27 * 27 Then
        A1式変換 = Chr(65 + ((col - 27 * 27) / 26 \ 26)) & _
                   Chr(65 + ((col - 27) \ 26) Mod 26) & _
                   Chr(65 + ((col - 1) Mod 26))
    Else
        A1式変換 = ""
    End If
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function R1C1式変換(ByVal Alpha As String) As Long
    R1C1式変換 = 0
    If Len(Alpha) = 1 Then
      R1C1式変換 = Asc(Alpha) Mod 32
      Exit Function
    End If
    Dim UnicodeArray() As Byte: UnicodeArray = Alpha
    Dim i As Long
    For i = LBound(UnicodeArray) To UBound(UnicodeArray) Step 2
      R1C1式変換 = R1C1式変換 * 26 + (UnicodeArray(i) Mod 32)
    Next
End Function

実行方法

「左右2シートをデータ照合キー比較()」を実行してください。

デフォルトはタイトルあり、比較結果マージの設定になってますが、目的に応じてカスタマイズしてください。

最後に

Excelの使い方は人それぞれ、いろんなやり方があると思いますが、一例としてご紹介させていただきました。

ExcelVBAマクロはちょっとした向上心さえあれば、取っ付きやすいプログラムなのでショートカットキーなどと組み合わせてぜひ活用してみてください。

Excel全ショートカットキー一覧はこちら↓↓↓

【Excel】エクセルの全ショートカット集｜プルダウンメニューまで完全網羅

表計算ソフトとして王者であるExcel。たくさんの人が使っていると思います。まぁまぁ高額ではありますが、その分、高機能なので使い倒したいとは思いませんか？単に表データを扱うだけではなく、図を挿入できたり、設計書などのドキュメントとして使った...

caymezon.com

2019.04.01

ちょっと工夫すれば、ちょっとした操作に１分かかっていた作業を１０秒でこなすことができるようになる可能性があります。

それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。

The post 【ExcelVBA】２シートをデータ照合キーで超簡単差分比較で色付け first appeared on CayTech Lab.

わざわざマウスを使ってある程度まとまった行を選択する操作、めんどくさくないですか？

頻繁にコピー作業する人にはきっと役に立つと思います。ショートカットを割り当てておけば、作業の爆速化は確実です。

使えそうであれば、使ってみてください。

一括行範囲選択マクロ(JavaScript)の操作イメージ

空行を次々と超簡単にコピーして別のテキストファイルに貼り付ける操作の例です。ショートカットキーを割り当てて操作してます。

一括行範囲選択マクロ(JavaScript)の主な仕様

細かい処理はコメントで補足してるので、ザックリとした仕様を箇条書きで記載します。

一括行範囲選択マクロ(JavaScript)ののソースコード

下記のソースを全てコピーしてファイルを作成し、マクロ配置場所（共通設定-マクロ）に格納してサクラエディタから起動してください。

一部のロジックは応用できると思うので、便利マクロの作成、JavaScriptの勉強などにもお役立てください。

// 任意文字列を含む行まで一括範囲選択コピー
// ※用途に応じて検索条件に任意の文字列を変更してご利用ください。（デフォルトは改行のみ）
// ※指定行で折り返されてる場合、正常に動作しないので
// 　「設定(O)-折り返し方法(X)-折り返さない(X)」で実行してください。

var WshShell = new ActiveXObject("WScript.Shell");

var selStRow=0,selEdRow=0,curRow=0,hitRow=0,fileEndRow=0,searchStr="",rowSelect=false;

try {

  // 行選択チェック
  selStRow = GetSelectLineFrom; // 選択開始行取得
  selEdRow = GetSelectLineTo;   // 選択終了行取得
  if (selStRow != selEdRow) { rowSelect = true; }

  if (!rowSelect) {
    // 行を選択していない場合
    GoLineTop; // 行頭に移動(折り返し単位)
    curRow = Number(ExpandParameter('$y')); // 実行開始時の行
    
  } else {
    // 行を選択している場合
    curRow = selStRow
    
  }
  
  // 検索文字列を設定(お好みでどうぞ)
  searchStr = "^(\r\n|\n)"; // 正規表現Crlfまたはlfのみの行
  //searchStr = "^[　 \t]*(\r\n|\n)"; // 全角・半角スペースやタブも空行とみなす場合
  //searchStr = "end if"; // 任意の文字列を含む行までとする場合(例:if～"end if")
  
  // 文字列検索　※正規表現で検索するため、検索オプションが変わるので注意。
  SearchNext(searchStr, 4);
  hitRow = Number(ExpandParameter('$y')); // 検索ヒット行取得
  
  // 最終行チェック
  GoFileEnd; // ファイルの最後に移動
  fileEndRow = Number(ExpandParameter('$y')); // ファイル最終行取得
  
  Jump(curRow,0);              // 現在行の先頭へジャンプ
  SearchClearMark;             // 検索マークの切替え(ハイライト解除)
  
  BeginSelect;                 // 範囲選択範囲選択モードオン
  
  if (hitRow < fileEndRow-1) { // 検索ヒット行がファイル最終行ではない場合
    Jump(hitRow+1,0);          // 検索ヒット行の一つ下先頭へジャンプ
    
    // 検索ヒットしない場合
    //if (preRow == hitRow) { GoFileEnd; } //ファイルの最後まで選択
    
  } else {
    // 検索文字列を含む行が[EOF]で終わってるか、[EOF]のみ行の一つ前の行に含む場合
    GoFileEnd; // ファイルの最後に移動
    
  }
  
  Copy; // 選択範囲をコピー
  
} catch (error) {
  WshShell.Popup(error ,0,"エラー",0);
  CancelMode; // 各種モードの取り消し
  
}

最後に

今回は自分が普段の作業で使ってる一括範囲選択コピーマクロをご紹介させていただきました。

ちょっとした簡単なマクロで作業効率化に抜群に効果がある可能性があります。

サクラエディタは超有効ツールなので、マクロに登録してぜひ使ってみてください。

いろいろなショートカットキーと組み合わせてぜひ活用してみてください。

サクラエディタ全ショートカットキー一覧はこちら↓↓↓

サクラエディタの全ショートカット集｜プルダウンメニューまで完全網羅

サクラエディタを使っていますでしょうか？　極上の機能を備えていながら、なんと無料！！仕事でも勉強でも大いに役立つ超オススメの神ツールです。開発者様には感謝です。エクセルやワードよりも使用頻度が高い人は結構多いと思います。自分にとって必要な機...

caymezon.com

2019.04.11

The post 【サクラエディタ】任意文字を含む行まで一括範囲選択コピー【操作画像あり】 first appeared on CayTech Lab.

例えば、最新のYahoo!ニュースの全カテゴリを一発で一覧に出力できたら便利です。

スクレイピングはいろいろな言語で対応可能だと思いますが、とりあえずGASで実装してみました。

Googleスプレッドシートであれば、割と簡単に自分好みのわかりやすい形にカスタマイズできます。

いろんな方法があると思いますが、正規表現によるゴリゴリの置換で実現してます。
スマートな方法ではないかもしれませんが、なるべく直感的にわかりやすいように実装してます。

もしよかったら参考にしてください。スクレイピング技術を使って必要な情報を効率的に取得しましょう。

Yahoo!ニュースページの取得箇所とスクレイピング操作イメージ映像

スクレイピングで取得するYahooニュースページソースの項目と実際にマクロを起動してスプレッドシートに反映するまでの映像です。

やるべきことのイメージを沸かせてみてください。

Yahoo!ニューススクレイピングGASマクロの主な仕様

細かい処理はコメントで補足してるので、ザックリとした仕様を箇条書きで記載します。

Yahoo!ニューススクレイピングGASマクロのソースコード

下記のソースを全てコピーして起動してください。

【GAS】Googleスプレッドシートでマクロの使い方入門【動画付】

Googleの「Google Apps Script」通称GAS。GoogleマップやGメールなど、いろんなGoogle関連のサービスと自由に連携できたり、独自のWebアプリを開発することもできる、いろんな可能性を秘めたワクワクの言語ですね...

caymezon.com

2019.05.02

目的に合っていない場合は適当にカスタマイズしてみてください。GASマクロの勉強にも少しは役立つと思います。

/* Yahoo!ニューススクレイピング */
function yahooNewsScraping() {
  
  // 確認メッセージフラグ
  var confirmMsgFlg = 0; // 0:確認メッセージを表示しない、1:確認メッセージを表示する
  
  // 開始位置
  var startRow = 4;
  var startColumn = 1;
  
  // 目次シートと各シート左上に目次リンク作成処理
  yahooNewsScrapingShori(confirmMsgFlg,
                         startRow,
                         startColumn);
  
}
////////////////////////////////////////////////////////////////////////////////
/* スクレイピング処理 */
function yahooNewsScrapingShori(confirmMsgFlg,
                                startRow,
                                startColumn) {
  
  var spSheet = SpreadsheetApp.getActiveSpreadsheet();
  var sheet = SpreadsheetApp.getActiveSheet(); // アクティブシート
  var pageRange = 10; // ページ制限範囲
  var outColCnt = 5; // 出力列数
  var categoryCol = 1; // カテゴリ
  var titleCol    = 2; // タイトル
  var upDtTmCol   = 3; // 掲載日時
  var urlCol      = 4; // URL
  var addDtTmCol  = 5; // 追加日時
  
  var inCategory = sheet.getRange(1,2).getValue();
  var inPageNo = sheet.getRange(2,2).getValue();
  var inPageNoTo = sheet.getRange(3,2).getValue();
  
  //////////チェック//////////
  if (inCategory == "") {
    Browser.msgBox("カテゴリが入力されていません。\\n"+"処理を終了します。"+"処理を終了します。");
    return;
  }
  if (inPageNo == "") {
    Browser.msgBox("ページ番号が入力されていません。\\n"+"処理を終了します。");
    return;
  } else {
    if (isNaN(Number(inPageNo))) {
      Browser.msgBox("ページ番号が数値ではありません。\\n"+"処理を終了します。");
      return; 
    } else {
      inPageNo = Number(inPageNo);
    }
  }
  if (inPageNoTo == "") {
    inPageNoTo = Number(inPageNo);
  } else {
    if (isNaN(inPageNo)) {
      Browser.msgBox("ページ番号Toが数値ではありません。\\n"+"処理を終了します。");
      return;
    } else {
      inPageNoTo = Number(inPageNoTo);
    }
    if (inPageNo > inPageNoTo) {
      Browser.msgBox("ページ範囲指定が逆です。\\n"+"処理を終了します。");
      return;
    }
    if (inPageNoTo-inPageNo+1 > pageRange) {
      Browser.msgBox("ページ制限範囲「"+pageRange+"」を超えてます。\\n"+"処理を終了します。");
      return;
    }
  }
  
  //////////確認処理//////////
  if (confirmMsgFlg == 1) {
    var msg = "";

    if (inPageNoTo == inPageNo) {
      msg = msg
      +"・Yahooニュース「"+inCategory+"」"+inPageNo+"ページ目のリストを出力します。\\n";
    } else {
      msg = msg
      +"・Yahooニュース「"+inCategory+"」"+inPageNo+"ページ目から"+inPageNoTo+"ページ目のリストを出力します。\\n";
    }
    
    msg = msg
     +"・タイトルで存在チェックし、既に存在している場合は追加しません。\\n";
    
    // 実行確認
    if (msg != "") {
      var msgRtn = Browser.msgBox(msg+"\\n実行してよろしいですか？",Browser.Buttons.OK_CANCEL);
      if (msgRtn == 'cancel') {return;}
    }
    
  }

  //////////コンテンツ取得//////////
  var Data = [];
  for (var p=inPageNo;p<=inPageNoTo;p++) {
  
    // 対象URL取得
    switch(inCategory) {
      case '全て':
        var inUrlArr = [
          ["国内",   "https://news.yahoo.co.jp/topics/domestic?page=" + p]
         ,["国際",   "https://news.yahoo.co.jp/topics/world?page=" + p]
         ,["経済",   "https://news.yahoo.co.jp/topics/business?page=" + p]
         ,["エンタメ","https://news.yahoo.co.jp/topics/entertainment?page=" + p]
         ,["スポーツ","https://news.yahoo.co.jp/topics/sports?page=" + p]
         ,["IT",     "https://news.yahoo.co.jp/topics/it?page=" + p]
         ,["科学",   "https://news.yahoo.co.jp/topics/science?page=" + p]
         ,["地域",   "https://news.yahoo.co.jp/topics/local?page=" + p]
        ];
        break;
      case '主要':
        var inUrl = "https://news.yahoo.co.jp/topics/top-picks?page=" + p;
        break;
      case '国内':
        var inUrl = "https://news.yahoo.co.jp/topics/domestic?page=" + p;
        break;
      case '国際':
        var inUrl = "https://news.yahoo.co.jp/topics/world?page=" + p;
        break;
      case '経済':
        var inUrl = "https://news.yahoo.co.jp/topics/business?page=" + p;
        break;
      case 'エンタメ':
        var inUrl = "https://news.yahoo.co.jp/topics/entertainment?page=" + p;
        break;
      case 'スポーツ':
        var inUrl = "https://news.yahoo.co.jp/topics/sports?page=" + p;
        break;
      case 'IT':
        var inUrl = "https://news.yahoo.co.jp/topics/it?page=" + p;
        break;
      case '科学':
        var inUrl = "https://news.yahoo.co.jp/topics/science?page=" + p;
        break;
      case '地域':
        var inUrl = "https://news.yahoo.co.jp/topics/local?page=" + p;
        break;
      default:
        Browser.msgBox("対象外のカテゴリです。\\n"+"処理を終了します。");
        return;
    }
    
    // HTML結果取得
    if (inCategory == "全て") {
      for (var i=0;i<\/div><\/div><\/div><\/a><\/li>/g);
  var liTag,aTag,url,dlTag,title,category,timeTag,upDtTm,upDate,upTime,addDtTm;
  for (var i=0;i<=liTags.length-1;i++) {
    // 空の配列作成
    var data = [];
    
    /////htmlタグからコンテンツを抽出/////
    liTag = liTags[i];
    // 「」と「」に囲まれたデータを取得（改行なし）
    title = String(liTag.match(/.*?<\/div>/g))
                    .replace(//,"").replace(/<\/div>/,"");
    category = inCategory; // カテゴリーは記載がない！！
    // 「」に囲まれたデータを取得
    timeTag = String(liTag.match(//g));
    Logger.log(timeTag);
    // 「」と「(」に囲まれたデータを取得
    upDate = String(timeTag.match(/.*?\(/g))
                         .replace(//,"").replace(/\(/,"");
    // 「)」と「」に囲まれたデータを取得
    upTime = String(timeTag.match(/\).*?<\/time>/g))
                       .replace(/\)/,"").replace(/<\/time>/,"");
    // 日時整形
    if ((upDate.match(/\//g )||[]).length == 1) { // "/"の数が1の場合はmm/dd、2の場合はyyyy/mm/ddと判断
      // 最新のYahoo!ニュース上の日付は年が付いていないので付加して変換
      upDtTm = formatDate(new Date(new Date().getFullYear()+"/"+upDate+" "+upTime),'yyyy/mm/dd(aaa) HH:MM');
    } else {
      upDtTm = formatDate(new Date(upDate+" "+upTime),'yyyy/mm/dd(aaa) HH:MM'); 
    }
    // 現在日時取得
    var now = Utilities.formatDate(new Date(),'Asia/Tokyo','yyyy/MM/dd HH:mm:ss');
    addDtTm = formatDate(new Date(now),'yyyy/mm/dd(aaa) HH:MM:ss');
    
    // 2次元配列に格納
    data.push(category); // カテゴリ
    data.push(title);    // タイトル
    data.push(upDtTm);   // 掲載日時
    data.push(url);      // URL
    data.push(addDtTm);  // 追加日時
    Data.push(data);     // １行データ格納
    
  }

  return Data;
  
}
////////////////////////////////////////////////////////////////////////////////
/* 日時フォーマット変換処理 */
function formatDate(date, format) {
  
  format = format.replace(/yyyy/g, date.getFullYear());
  format = format.replace(/mm/g, ('0' + (date.getMonth() + 1)).slice(-2));
  format = format.replace(/dd/g, ('0' + date.getDate()).slice(-2));
  format = format.replace(/aaa/g, ['日','月','火','水','木','金','土'][date.getDay()])
  format = format.replace(/AAA/g, ['Sun','Mon','Tue','Wed','Thu','Fri','Sat'][date.getDay()])
  format = format.replace(/HH/g, ('0' + date.getHours()).slice(-2));
  format = format.replace(/MM/g, ('0' + date.getMinutes()).slice(-2));
  format = format.replace(/ss/g, ('0' + date.getSeconds()).slice(-2));
  format = format.replace(/SSS/g, ('00' + date.getMilliseconds()).slice(-3));
  
  return format;
  
};
////////////////////////////////////////////////////////////////////////////////
/* クリア処理 */
function yahooNewsClear() {
  
  // 開始位置
  var spSheet = SpreadsheetApp.getActiveSpreadsheet();
  var sheet = SpreadsheetApp.getActiveSheet(); // アクティブシート
  var startRow = 4;
  var startColumn = 1;
  var outColCnt = 6;
  
  /////罫線削除/////
  // データ部
  sheet.getRange(startRow+1,1,sheet.getMaxRows(),outColCnt)
    .setBorder(false,false,false,false,false,false);
  
  // クリア処理（開始位置から最終行まで一旦クリアし再作成する）
  sheet.getRange(startRow,startColumn,sheet.getMaxRows()-startRow+1,outColCnt).clearContent();
  try{ sheet.getFilter().remove(); } catch(e) { Logger.log(e); }
                       
}

Googleスプレッドシートの全ショートカット集｜プルダウンメニューまで完全網羅

表計算ソフトとして、まだまだExcelのシェア率は高いですが、GoogleスプレッドシートにはExcelにはない超強力な関数があったり、Excelとは違って常に最新版を無料で使用できます。なにより、インターネットを使ったオンライン上での活用...

caymezon.com

2019.03.16

ちょっと工夫すれば、ちょっとした操作に１分かかっていた作業を１０秒でこなすことができるようになる可能性があります。

それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。

The post 【GAS】Yahooニュースをスクレイピング【サンプルソース付】 first appeared on CayTech Lab.

Excelと比べるとパフォーマンスは若干悪いので、操作もできる限り効率化すべきですね。

また、シートの数が多いと目的のシートに次々と移動したい時、大抵一番左側にある目次シートに戻ってくるのって結構めんどくさいですよね。

そんな時は、各シートに目次シートへのリンクを作っておけば、相互にマウスクリックでジャンプするだけなのでメチャメチャ作業が楽になります。

そこでGASにて目次シートを超簡単に作成するマクロを実装してみましたので、目的に合致した場合はぜひ使ってみてください。

Excelに比べると作成処理は結構遅いですが、シート管理のしやすさ、シート参照速度は爆上げされると思います。

百聞は一見に如かず、一目瞭然、一発でイメージが湧き、使い方がわかるようなGIFアニメ付きです。

目次と各リンクをシート内で相互にハイパーリンクでジャンプしたい

たくさんのシートを作成した時、目次があると大変便利です。

一瞬で目次を作成して各シートにジャンプでき、そのジャンプ先のシートからも目次に一瞬で戻ってきたい場面って結構ありませんか？

そんな方達向けにまぁまぁ汎用的なマクロを作ってみました。

Googleスプレッドシートの目次リンク作成GASマクロの操作イメージサンプル例

マクロを登録して、下記の画像操作と同じようにやってみてください。

ページ番号＋シート名

シート数が一発でわかるシートの順番に並べたページ番号付きです。シートの順番を変えて再度実行すれば番号も再整理されます。

目次リンクの折り返し制御

快適に目次からサクサクと各シートにジャンプするためには、目次シートは一発で全シートが見える状態がベストですよね。

単純に１列のみのリスト出力だと、１００シートを超える場合はいちいちスクロールする手間が発生してしまいます。

柔軟に複数列で目次リストを作成できるように折り返し制御を盛り込みました。

用途に合わせて定義を変更し、微調整してください。

目次リンク作成GASマクロの主な仕様

細かい処理はコメントで補足してるので、ザックリとした仕様を箇条書きで記載します。

目次リンク作成GASマクロのソースコード

目次ジャンプ効率を爆上げしたい方は、下記のソースコードを以下↓↓↓のリンクの内容に従ってコピーしてご使用ください。

【GAS】Googleスプレッドシートでマクロの使い方入門【動画付】

Googleの「Google Apps Script」通称GAS。GoogleマップやGメールなど、いろんなGoogle関連のサービスと自由に連携できたり、独自のWebアプリを開発することもできる、いろんな可能性を秘めたワクワクの言語ですね...

caymezon.com

2019.05.02

目的に合っていない場合は適当にカスタマイズしてみてください。GASマクロの勉強にも少しは役立つと思います。

/* 目次シート作成 */
function mokujiSheetMake() {
  
  // 確認メッセージフラグ
  var confirmMsgFlg = 0; // 0:確認メッセージを表示しない、1:確認メッセージを表示する
  
  // 処理区分
  var shoriKbn = 1
      // 0:目次シートのみ作成(各シート目次リンクがある場合は削除)
      // 1:目次シート作成＋各シート目次リンク作成
  /////目次シート定数/////
  var mokujiSheetNm = "目次";                    // 目次シート名
  var mokujiLstWrapRow = 10;                     // 目次リスト折り返し行数
  var mokujiLstWrapCol = 3;                      // 目次リスト折り返し列数
  var mokujiLstRowMargin = 3; // 上余白          // 目次リスト行マージン
  var mokujiLstColMargin = 1; // 左余白          // 目次リスト列マージン
  
  /////各シート定数/////
  var everyShtMokujiLnkNm = mokujiSheetNm+"へ"; // 各シート目次リンク名
  
  // 目次シートと各シート左上に目次リンク作成処理
  mokujiSheetmakeShori(confirmMsgFlg,
                       shoriKbn,
                       mokujiSheetNm,
                       mokujiLstWrapRow,
                       mokujiLstWrapCol,
                       mokujiLstRowMargin,
                       mokujiLstColMargin,
                       everyShtMokujiLnkNm);
                       
}
////////////////////////////////////////////////////////////////////////////////
/* 目次シートと各シート左上に目次リンク作成処理 */
function mokujiSheetmakeShori(confirmMsgFlg,
                              shoriKbn,
                              mokujiSheetNm,
                              mokujiLstWrapRow,
                              mokujiLstWrapCol,
                              mokujiLstRowMargin,
                              mokujiLstColMargin,
                              everyShtMokujiLnkNm) {
                              
  //////////概要//////////
  //スプレッドシート内の全シートにリンクするリストを表示した目次シートを作成
  //スプレッドシート内の各シートに目次シートへのリンクを作成
  
  var spSht = SpreadsheetApp.getActiveSpreadsheet();
  var sheets = spSht.getSheets();
  
  //////////定義//////////
  /////目次シートワーク変数/////
  var rowSeq,colSeq,mokujiLstRow,mokujiLstRowMargin,mokujiLstCol,mokujiLstColMargin;
  
  //////////確認処理//////////
  if (confirmMsgFlg == 1) {
    var msg = "";
    if (shoriKbn == 0) {
      msg = msg+"＜目次シートのみ作成＞\\n";
    } else if (shoriKbn = 1) {
      msg = msg+"＜目次シート作成＋各シート目次リンク作成＞\\n";
    }
    msg = msg+"\\n";
    
    msg = msg
     +"・目次シートに各シートへリンクする目次リストを作成します。\\n"
     +"・目次シートが存在しない場合は新規シートを作成します。\\n"
     +"・既に目次シートが存在する場合は一旦クリア後に再作成します。\\n"
     +"・シート数「"+mokujiLstWrapRow+"」行で次列に折り返します。\\n";
     
    if (shoriKbn == 0) {
      msg = msg
       +"・各シートに目次シートへのリンク（テキストボックス)「"
         +everyShtMokujiLnkNm+"」が存在する場合は全て削除します。\\n"
       +"　※各シートの目次リンクは作成しません。\\n"
       +"　（全シートに誤って作成してしまったリンクを削除する場合に有効）\\n";
    } else if (shoriKbn == 1) {
      msg = msg
       +"・各シートに目次シートへのリンク（A列新規追加後にA1セル）「"
         +everyShtMokujiLnkNm+"」を作成します。\\n"
       +"　※既に存在する場合は一旦削除後に再作成します。\\n"
       +"　（目次シートと各シートを相互にリンクしたい場合に有効）\\n";
    }
    
    // 実行確認
    if (msg != "") {
      var msgRtn = Browser.msgBox(msg+"\\n実行してよろしいですか？",Browser.Buttons.OK_CANCEL);
      if (msgRtn == 'cancel') {return;}
    }
    
  }
  
  //////////チェック//////////
  if (mokujiLstWrapCol < 2) {
    Browser.msgBox("番号とリンクで最低2列必要なので、折り返し列数は「2」以上を設定してください。\\n"
      +"処理を終了します。");
    return;
  }
  
  /////目次シート作成/////
  //シートが存在しない場合は「目次」シートを先頭に新規作成
  var mokujiExistsFlg = 0;
  for (var i=0;i 2) { //マージン不足の場合は設定しない
    mokujiSheet.getRange(mokujiLstRowMargin-1,mokujiLstColMargin+1).setValue(mokujiSheetNm)
    .setFontWeight('bold');
  }
  
  mokujiSheet.getRange('A1').activate();
  
}

目次リンク作成マクロのGASとExcelVBAとの違い

Excel版はコチラ。

【ExcelVBA】目次シートと全シート目次リンクを超簡単作成

Excelを使っている時、一つのブックにたくさんのシートを作成する場面って結構ありませんか？そんな時、目次シートがあったら便利ですよね。でも、シートの数が多いと目的のシートに次々と移動したい時、いちいち大抵一番左側にある目次シートに戻ってく...

caymezon.com

2019.04.26

コーディングの内容は全然違いますが、仕様、ロジックはほとんど同じです。

ExcelからGoogleスプレッドシートに徐々にでも移行を考えている方は見比べて参考にしてみてください。

最後に

Googleスプレッドシートの使い方は人それぞれ、いろんなやり方があると思いますが、一例としてご紹介させていただきました。

GASマクロはExcelVBAとはかなり違いますが、JavaScriptは覚えておいて損はないプログラムだと思うのでショートカットキーなどと組み合わせてぜひ活用してみてください。

Googleスプレッドシート全ショートカットキー一覧はこちら↓↓↓

Googleスプレッドシートの全ショートカット集｜プルダウンメニューまで完全網羅

表計算ソフトとして、まだまだExcelのシェア率は高いですが、GoogleスプレッドシートにはExcelにはない超強力な関数があったり、Excelとは違って常に最新版を無料で使用できます。なにより、インターネットを使ったオンライン上での活用...

caymezon.com

2019.03.16

ちょっと工夫すれば、ちょっとした操作に１分かかっていた作業を１０秒でこなすことができるようになる可能性があります。

それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。

The post 【GAS】スプレッドシートのハイパーリンクで目次と全シートリンクを超簡単作成 first appeared on CayTech Lab.

そんな操作を仕事や勉強で頻繁に行う必要がある人も結構多いはず。

そんな時、いちいち列幅を調整して枠線を付ける段階的な作業ってめんどくさいですよね。

Googleスプレッドシートでいろんなデータを扱う際、列幅を調整したり、枠線を付けたり、一発で表を見やすい形にしたくありませんか？

GASで超簡単に綺麗な表を作成するマクロを実装してみましたので、目的に合った場合はぜひコピーして使ってみてください。

百聞は一見に如かず、一目瞭然、一発でイメージが湧き、使い方がわかるようなGIFアニメ付きです。

Googleスプレッドシートの列幅と罫線GASマクロ操作イメージ

マクロを登録して、下記の画像操作と同じようにやってみてください。

列幅と罫線GASマクロの主な仕様

細かい処理はコメントで補足してるので、ザックリとした仕様を箇条書きで記載します。

列幅と罫線GASマクロのソースコード

表作成効率を爆上げしたい方は、下記のソースコードを以下↓↓↓のリンクの内容に従ってコピーしてご使用ください。

【GAS】Googleスプレッドシートでマクロの使い方入門【動画付】

Googleの「Google Apps Script」通称GAS。GoogleマップやGメールなど、いろんなGoogle関連のサービスと自由に連携できたり、独自のWebアプリを開発することもできる、いろんな可能性を秘めたワクワクの言語ですね...

caymezon.com

2019.05.02

目的に合っていない場合は適当にカスタマイズしてみてください。GASマクロの勉強にも少しは役立つと思います。

/* 列幅自動調整_表枠線付加 */
function colWidthChoseiBoderAdd() {
  
  // 確認メッセージフラグ
  var confirmMsgFlg = 0; // 0:確認メッセージを表示しない、1:確認メッセージを表示する
  
  // 列幅調整フラグ
  var colWidthChoseiFlg = 1 // 0:列幅調整しない、1:列幅調整する
  // 枠線付加フラグ
  var boderAddFlg = 1 // 0:枠線付加しない、1:枠線付加する
  // 終了位置判定区分
  var endPointkbn = 1 // 1:開始位置から行・列データ全て、2:開始位置から連続値最終位置まで
  // 列幅自動調整_表枠線付加処理
  colWidthChoseiBoderAddShori(confirmMsgFlg,colWidthChoseiFlg,boderAddFlg,endPointkbn);
  
}
////////////////////////////////////////////////////////////////////////////////
/* 列幅自動調整_表枠線付加処理 */
function colWidthChoseiBoderAddShori(confirmMsgFlg,colWidthChoseiFlg,boderAddFlg,endPointkbn) {

  //////////概要//////////
  //表の列幅を自動調整して枠線を付加する
  
  //////////前提//////////
  //1行目タイトル、2行目以降がデータの表を対象する
  //複数行・複数列の表を対象とする（1行のみ、または1列のみの場合はチェック処理で強制終了）
  //　※終了位置によってMAXまで処理してしまうのを回避するため
  
  var sheet = SpreadsheetApp.getActiveSheet();
  var range = sheet.getActiveRange(); // 選択範囲セル
  
  //////////確認処理//////////
  if (confirmMsgFlg == 1) {
    var msg = "";
    if (colWidthChoseiFlg == 1) {
      msg = msg+"・選択範囲セル2行目以降データで列幅を自動調整します。\\n";
    }
    if (boderAddFlg == 1) {
      msg = msg+"・表データに枠線を付加し、タイトル行に色付けします。\\n";
    }
    if (endPointkbn == 1) {
      msg = msg+"・開始位置から行・列データ全てを対象とします。\\n";
    } else if (endPointkbn == 2) {
      msg = msg+"・開始位置から連続で値が存在する最後のセルまでを対象とします。\\n";
    }
    if (msg != "") {
      var msgRtn = Browser.msgBox(msg+"\\n実行してよろしいですか？",Browser.Buttons.OK_CANCEL);
      if (msgRtn == 'cancel') {return;}
    }
  }
  
  //////////開始位置//////////
  var startRow = range.getRow();    // 開始行
  var startCol = range.getColumn(); // 開始列
  //var startRowColMsg = "開始行:"+startRow+",開始列"+startCol;
  //Logger.log(startRowColMsg);

  //////////シート全体の最終位置//////////
  // シート全体の最終行（値を持つセル範囲の最終行からCtrl+↓で移動した行位置が必ずシート最終行になると判断）
  //var sheetLastRow = sheet.getRange(sheet.getLastRow(),range.getColumn())
  //                   .getNextDataCell(SpreadsheetApp.Direction.DOWN).getRow();
  var sheetLastRow = sheet.getMaxRows();
  // シート全体の最終列（値を持つセル範囲の最終列からCtrl+→で移動した列位置が必ずシート最終列になると判断）
  //var sheetLastCol = sheet.getRange(range.getRow(),sheet.getLastColumn())
  //                   .getNextDataCell(SpreadsheetApp.Direction.NEXT).getColumn();
  var sheetLastCol = sheet.getMaxColumns();
  //var sheetLastRowColMsg = "シート全体の最終行:"+sheetLastRow+",シート全体の最終列"+sheetLastCol;
  //Logger.log(sheetLastRowColMsg);

  //////////終了位置//////////
  if (endPointkbn == 1) {
    // データの終了行（シート最終行から上に値を探索して値が見つかった行をデータ最終行とする(Ctrl+↑)）
    var dataLastRow = sheet.getRange(sheetLastRow,startCol)
                      .getNextDataCell(SpreadsheetApp.Direction.UP).getRow();
    // データの終了列（シート最終列から左に値を探索して値が見つかった行をデータ最終列とする(Ctrl+←)）
    var dataLastCol = sheet.getRange(startRow,sheetLastCol)
                      .getNextDataCell(SpreadsheetApp.Direction.PREVIOUS).getColumn();
  } else if (endPointkbn == 2) {
    // データの終了行（開始行から下に空データを探索して値が見つかった行をデータ最終行とする(Ctrl+↓)）
    var dataLastRow = sheet.getRange(startRow,startCol)
                      .getNextDataCell(SpreadsheetApp.Direction.DOWN).getRow();
    // データの終了列（開始列から右に空データを探索して値が見つかった列をデータ最終列とする(Ctrl+→)）
    var dataLastCol = sheet.getRange(startRow,startCol)
                      .getNextDataCell(SpreadsheetApp.Direction.NEXT).getColumn();
  }
  //var dataLastRowColMsg = "データの終了行:"+dataLastRow+",データの終了列"+dataLastCol;
  //Logger.log(dataLastRowColMsg);
  
  //////////チェック//////////
  // 行データがない（終了行がシート最終行）、または
  // 列データがない（最終列がシート最終列）場合は強制終了
  if (startRow >= dataLastRow || dataLastRow == sheetLastCol) {
    Browser.msgBox("行データがありません。");
    return;
  } else if (startCol >= dataLastCol || dataLastCol == sheetLastCol) {
    Browser.msgBox("列データがありません。");
    return;
  }
  
  //////////列幅自動調整//////////
  if (colWidthChoseiFlg == 1) {
  // 自動調整or値のバイト長からの調整、好きな方をお選びください。
    
    // 列幅自動調整 →２バイト文字（日本語）だと3/5くらいの幅になってしまうので注意
    //sheet.autoResizeColumns(startCol,dataLastCol-startCol+1);
    
    // データの値で列幅を計算して調整 →列毎に処理するためパフォーマンスが悪いので注意
    for(var i=startCol;i<=dataLastCol;i++){ // 列ループ
      var maxLenB = 1;    // 列毎の最大バイト長
      for(var j=startRow+1;j<=dataLastRow;j++){ // 行ループ
        // ※1行目をタイトル前提とし2行目以降を列幅調整の対象とする。
        if (sheet.getRange(j,i).getValue() != "") { // 空ではない場合
          //var chkVal = sheet.getRange(j,i).getValue(); // 数値などの場合、indexOfエラーとなる。
          var chkVal = sheet.getRange(j,i).getDisplayValue();
          // 改行を含む場合は先頭行で判断
          if (chkVal.indexOf("\n") != -1) {chkVal = chkVal.slice(0,chkVal.indexOf("\n"));}
          var colLenB = strLenByte(chkVal);
          if (maxLenB < colLenB) { // 最大長判定 
            maxLenB = colLenB;
          }
          //Logger.log("行:"+j+"列:"+i+"→"+strLenByte(cellVal));
        }
      }
      //Logger.log("maxLenB:"+maxLenB+","+"colWidth:"+sheet.getColumnWidth(i));
      sheet.setColumnWidth(i,maxLenB*7+(maxLenB-1)+8); // 半角だと割と綺麗に調整される（全角だと少し膨らむ）
      //sheet.setColumnWidth(i,maxLenB*7+(maxLenB-1)+8-(maxLenB*2)+15); // 狭めたい場合は適当に微調整が必要
    }
    
  }

  //////////表枠線付加//////////
  if (boderAddFlg == 1) {
    
    //////////タイトル部//////////
    sheet.getRange(startRow,startCol,1,dataLastCol-startCol+1)
    .setWrapStrategy(SpreadsheetApp.WrapStrategy.WRAP) // 折り返し
    .setVerticalAlignment('middle') // 中央に配置
    .setBackground('#CCFFCC') // 背景色（薄い緑）
     // 上・左・下・右・垂直・水平を全て実線
    .setBorder(true,true,true,true,true,true,'#000000',SpreadsheetApp.BorderStyle.SOLID);
    
    //////////データ部//////////
    sheet.getRange(startRow+1,startCol,dataLastRow-startRow,dataLastCol-startCol+1)
    // 上・左・下・右・垂直は実線
    .setBorder(true,true,true,true,true,null,'#000000',SpreadsheetApp.BorderStyle.SOLID)
    // 水平は点線
    .setBorder(null,null,null,null,null,true,'#000000',SpreadsheetApp.BorderStyle.DOTTED);
    
  }
  
  //sheet.getRange(startRow,startCol).activate(); // A1セル選択
  //sheet.getRange(1,startCol,sheetLastRow,dataLastCol-startCol+1).activate(); // →列選択にはならない
  sheet.getRange(colA1Conv(startCol)+":"+colA1Conv(dataLastCol)).activate(); // 列選択（マウスで任意調整）
  //└→列番号のみ指定のやり方がわからないので強制的にA,B,…,Z,AA,AB,…に変換して選択
  
}
////////////////////////////////////////////////////////////////////////////////
// 2バイト文字は2バイトとしてカウントする関数
function strLenByte(str) {

  var len = 0;
  str = escape(str);
  for(var i=0;i

---

列幅と罫線マクロのGASとExcelVBAとの違い

Excel版はコチラ。

【ExcelVBA】列幅を自動調整して枠線付の綺麗な表を簡単作成

インターネットやデータベースなどからデータを抽出してExcelに貼り付けてデータを整理したい場面はあるかと思います。そんな操作を仕事や勉強で頻繁に行う必要がある人も結構多いと思います。そんな時、いちいち列幅を調整して枠線を付ける段階的な作業...

caymezon.com

2019.04.20

コーディングの内容は全然違いますが、仕様、ロジックはほとんど同じです。

ExcelからGoogleスプレッドシートに徐々にでも移行を考えている方は見比べて参考にしてみてください。

---

最後に

Googleスプレッドシートの使い方は人それぞれ、いろんなやり方があると思いますが、一例としてご紹介させていただきました。

GASマクロはExcelVBAとはかなり違いますが、JavaScriptは覚えておいて損はないプログラムだと思うのでショートカットキーなどと組み合わせてぜひ活用してみてください。

Googleスプレッドシート全ショートカットキー一覧はこちら↓↓↓

Googleスプレッドシートの全ショートカット集｜プルダウンメニューまで完全網羅

表計算ソフトとして、まだまだExcelのシェア率は高いですが、GoogleスプレッドシートにはExcelにはない超強力な関数があったり、Excelとは違って常に最新版を無料で使用できます。なにより、インターネットを使ったオンライン上での活用...

caymezon.com

2019.03.16

ちょっと工夫すれば、ちょっとした操作に１分かかっていた作業を１０秒でこなすことができるようになる可能性があります。

それだけでも、積み上げれば相当の工数を削減できるはずなので、ぜひ自分に合ったやり方を模索していきましょう。

---

The post 【GAS】スプレッドシートで列幅調整と罫線付の綺麗な表を簡単作成【操作画像付】 first appeared on CayTech Lab.

]]>