2021-02-28

EXCEL関数でグループごとに連番を振る方法-CountIf使わない版

A列にグループごとに連番を振りたいデータが入っているとして A2セルに

=XMATCH(ROW(),FILTER(ROW(A:A),A:A=A2))

と入れて下までコピー

結果

f:id:robbie21:20210228140411p:plain

解説

 FILTER(ROW(A:A),A:A=A2)

は A2と同じデータのセルの行番号の集合を作ります｡ここでは､ 2, 3, 6, 11です｡

この中からXMATCH(ROW()...を使用して,A2の行番号が何番目になっているかを調べます｡

B2セルの行番号は2なので 2, 3, 6, 11 の1番目です｡よってB2セルには1が入ります｡

参考: CountIf関数を使う方法
- Excelで分類・グループごとにサクっと連番を振る方法インクループ株式会社さん

2020-03-24

VBAで配列リテラル風なこと

多くの言語で

array = ["a","b","c"]

のように配列の値を直接コード中に指定する方法が提供されているが,VBAには無い｡

配列の宣言とSplit関数を用いることで擬似的に文字列を要素とする配列のリテラルを実現することができる｡

Dim Array

Array = Split("a b c")

活用例

Sub UseSplit()
Dim Staffs
Staffs = Split("中野田中有田")
Dim Person
For Each Person In Staffs
Debug.Print Person
Next
End Sub

出力結果

中野
田中
有田

2020-03-23

VBAで配列リテラル風なこと

多くの言語で

array = ["a","b","c"]

のように配列の値を直接コード中に指定する方法が提供されているが,VBAには無い｡

配列の宣言とSplit関数を用いることで擬似的に文字列を要素とする配列のリテラルを実現することができる｡


Dim Array
Array = Split("a b c")

活用例


Dim Array
  Array = Split("a b c")
  Dim i
  For Each i in Array
    Debug.Print i
  Next

2018-01-06

結合したセルの高さを自動調節する(縦方向の結合にも対応)

Excel VBA

縦方向の結合にも対応させてみたが思ったより大げさになってしまった。

Option Explicit

'結合したセルの高さを自動調節する
'
' 処理の概要
' - 新しいブックを作成し、書式、標準のフォントとそのサイズを選択したセル範囲からコピー
'   (標準のフォントの大きさによって長さ当たりのピクセル数が変わってくるので標準のフォントを揃えること重要)
' - 結合したセル範囲の一覧を作成しDictionaryObjectに保存する
' - 結合したセル範囲を一つずつ取り出しテスト用のセルにコピーする
' - テスト用のセルを結合後の幅に揃えたうえでAutoFitする。
' - テスト用セルの高さと現在の高さを比べて高いほうに高さを設定する。
Sub AutofitMergedCells()
    AutofitMergedCells_ Selection
End Sub


Private Sub AutofitMergedCells_(Target As Range)
    '自動調節したいセル範囲、ブック等を変数に格納 =>TargetBook
    Dim TargetBook As Workbook
    Set TargetBook = Target.Worksheet.Parent
    Dim NormalFontName As String
    NormalFontName = TargetBook.Styles("Normal").Font.Name ' 後で取得するとなぜかMSゴシックが返ってくるので最初に取得しておく
    Dim NormalFontSize As Double
    NormalFontSize = TargetBook.Styles("Normal").Font.Size
    
    
    '高さを調べるためのテスト用ブックの用意 =>TestBook    '
    Dim TestBook As Workbook
    Set TestBook = Workbooks.Add
    Dim TestSheet As Worksheet
    Set TestSheet = TestBook.Worksheets(1)
    Dim TestCell As Range
    Set TestCell = TestSheet.Cells(1, 1)
    'テストブックのNormalスタイル
    TestBook.Styles("Normal").Font.Name = NormalFontName
    TestBook.Styles("Normal").Font.ThemeFont = xlThemeFontNone
    TestBook.Styles("Normal").Font.Size = NormalFontSize

    Dim tmpRow As Range
    For Each tmpRow In Target.Rows
        tmpRow.AutoFit
    Next
    
    Dim Areas As New Scripting.Dictionary
    Set Areas = MergedAreas(Target)
    Dim k
    For Each k In Areas.Keys
        Dim Area As Range
        Set Area = Areas(k)
        
        Dim RemainHeight As Double
        RemainHeight = HeightToFit(Area, TestCell)
        Dim RowHeight As Double
        
        Dim Row As Range
        Dim Index As Long
        Index = 1
        While 0 < RemainHeight
            RowHeight = RemainHeight / (Area.Rows.Count - Index + 1)
            Set Row = Area.Rows(Index)
            If Row.RowHeight < RowHeight Then
                Row.RowHeight = RowHeight
            End If
            RemainHeight = RemainHeight - Row.RowHeight
            Index = Index + 1
        Wend
        
Continue_:
    Next
    TestBook.Close False
End Sub

'結合したセルをAutoFitした場合の高さ
Private Function HeightToFit(Area As Range, TestCell As Range)
    Dim Row As String
    Dim MergedAreas As New Scripting.Dictionary
    Dim c As Range
    For Each c In Area.Cells
        If Not MergedAreas.Exists(c.MergeArea.Address) Then
            MergedAreas.Add c.MergeArea.Address, c.MergeArea
        End If
    Next
    
    Dim MergedCells
    
    
    HeightToFit = 0
    For Each MergedCells In MergedAreas.Items
        
        Dim MergedWidth As Double
        MergedWidth = 0
        Dim Col As Range
        For Each Col In MergedCells.Columns
            MergedWidth = MergedWidth + Col.ColumnWidth
        Next
        MergedWidth = MergedWidth
        MergedCells.Copy
        TestCell.Worksheet.Paste TestCell
    
        TestCell.MergeCells = False
        TestCell.ColumnWidth = MergedWidth
        TestCell.Value = MergedCells.Value
        
        TestCell.EntireRow.AutoFit
        HeightToFit = IIf(HeightToFit < TestCell.RowHeight, TestCell.RowHeight, HeightToFit)
    Next
End Function


Private Function MergedAreas(Range As Range) As Scripting.Dictionary
    Dim Dict As New Dictionary
    Dim Cell As Range
    For Each Cell In Range
        If Cell.MergeCells And Not Dict.Exists(Cell.MergeArea.Address) Then
            Dict.Add Cell.MergeArea.Address, Cell.MergeArea
        End If
    Next
    Set MergedAreas = Dict
End Function

2018-01-05

横方向に結合したセルの高さを自動調節する

Excel VBA

'横方向に結合したセルの高さを自動調節する
'
' 処理の概要
' - 新しいブックを作成し、書式、標準のフォントとそのサイズを選択したセル範囲からコピー
'   (標準のフォントの大きさによって長さ当たりのピクセル数が変わってくるので標準のフォントを揃えること重要)
' - 結合したセルの値をテスト用のセルにコピーする、テスト用のセルを結合後の幅に揃えたうえでAutoFitする。
' - テスト用セルの高さと同じ高さに結合したセルの高さを設定する。

Sub AutoFitMergedCells()
    
    '自動調節したいセル範囲、ブック等を変数に格納 =>TargetBook
    Dim TargetBook As Workbook
    Dim TargetRows As Range
    Set TargetRows = Selection.Rows
    Set TargetBook = TargetRows.Worksheet.Parent
    Dim NormalFontName As String
    NormalFontName = TargetBook.Styles("Normal").Font.Name ' 後で取得するとなぜかMSゴシックが返ってくるので最初に取得しておく
    Dim NormalFontSize As Double
    NormalFontSize = TargetBook.Styles("Normal").Font.Size
    
    
    '高さを調べるためのテスト用ブックの用意 =>TestBook
    '
    Dim TestBook As Workbook
    Set TestBook = Workbooks.Add
    Dim TestSheet As Worksheet
    Set TestSheet = TestBook.Worksheets(1)
    
    Dim TestCell As Range
    Set TestCell = TestSheet.Cells(1, 1)
    
    TestBook.Styles("Normal").Font.Name = NormalFontName
    TestBook.Styles("Normal").Font.ThemeFont = xlThemeFontNone
    TestBook.Styles("Normal").Font.Size = NormalFontSize

    
    Dim Row As Range
    For Each Row In TargetRows

        Dim MergedCells As Range
        Set MergedCells = Row
        
        Dim MergedWidth As Double
        MergedWidth = 0
        Dim Col
        For Each Col In MergedCells.Areas(1).Columns
            MergedWidth = MergedWidth + Col.ColumnWidth
        Next
        MergedWidth = MergedWidth
        MergedCells.Copy
        TestSheet.Paste TestCell

        TestCell.MergeCells = False
        TestCell.ColumnWidth = MergedWidth
        TestCell.Value = MergedCells.Value
        
        TestCell.EntireRow.AutoFit
        MergedCells.RowHeight = TestCell.RowHeight
    Next
End Sub

2018-01-05

横方向に結合したセルの高さを自動調節する

Excel VBA

'横方向に結合したセルの高さを自動調節する
'
' 処理の概要
' - 新しいブックを作成し、書式、標準のフォントとそのサイズを選択したセル範囲からコピー
'   (標準のフォントの大きさによって長さ当たりのピクセル数が変わってくるので標準のフォントを揃えること重要)
' - 結合したセルの値をテスト用のセルにコピーする、テスト用のセルを結合後の幅に揃えたうえでAutoFitする。
' - テスト用セルの高さと同じ高さに結合したセルの高さを設定する。

Sub AutoFitMergedCells()
    
    '自動調節したいセル範囲、ブック等を変数に格納 =>TargetBook
    Dim TargetBook As Workbook
    Dim TargetRows As Range
    Set TargetRows = Selection.Rows
    Set TargetBook = TargetRows.Worksheet.Parent
    Dim NormalFontName As String
    NormalFontName = TargetBook.Styles("Normal").Font.Name ' 後で取得するとなぜかMSゴシックが返ってくるので最初に取得しておく
    Dim NormalFontSize As Double
    NormalFontSize = TargetBook.Styles("Normal").Font.Size
    
    
    '高さを調べるためのテスト用ブックの用意 =>TestBook
    '
    Dim TestBook As Workbook
    Set TestBook = Workbooks.Add
    Dim TestSheet As Worksheet
    Set TestSheet = TestBook.Worksheets(1)
    
    Dim TestCell As Range
    Set TestCell = TestSheet.Cells(1, 1)
    
    TestBook.Styles("Normal").Font.Name = NormalFontName
    TestBook.Styles("Normal").Font.ThemeFont = xlThemeFontNone
    TestBook.Styles("Normal").Font.Size = NormalFontSize

    
    Dim Row As Range
    For Each Row In TargetRows

        Dim MergedCells As Range
        Set MergedCells = Row
        
        Dim MergedWidth As Double
        MergedWidth = 0
        Dim Col
        For Each Col In MergedCells.Areas(1).Columns
            MergedWidth = MergedWidth + Col.ColumnWidth
        Next
        MergedWidth = MergedWidth
        MergedCells.Copy
        TestSheet.Paste TestCell

        TestCell.MergeCells = False
        TestCell.ColumnWidth = MergedWidth
        TestCell.Value = MergedCells.Value
        
        TestCell.EntireRow.AutoFit
        MergedCells.RowHeight = TestCell.RowHeight
    Next
End Sub

2017-10-14

GoogleSpreadsheetでファイルを越えてのコピー

GAS

Google Apps Script
SpreadSheetで通常のCopyTo()では別のファイルへのコピーができないので作成。

//他のファイルのシートにコピーする
//数式と値のみ、書式はコピーされない
function copyToAnotherFile(fromSheet, toSheet){
  var fromRange = fromSheet.getDataRange();
  var values  = fromRange.getValues();
  var address = fromRange.getA1Notation();
  var toRange = toSheet.getRange(address);
  var formulas = fromRange.getFormulas();
  
  for( var rowIndex = 0;rowIndex<values.length;rowIndex++){
     var row = values[rowIndex];
    for( var colIndex = 0; colIndex<values[0].length;colIndex++){
      var formula =formulas[rowIndex][colIndex];
      if(formula!=''){
        values[rowIndex][colIndex] = formulas[rowIndex][colIndex];
      }
    }
  }
  toRange.setValues(values);
}