SSブログ

エクセル小僧:入れ子になっている1次元配列を2次元配列に変換 [コンピューター]

VBAマクロで、入れ子になっている1次元配列を2次元配列に変換し、ワークシート上に縦方向
に展開した後、横方向に転置するというのをやってみました。

ワークシートは、こんな感じ。

kinmu2.jpg

【参考】
Arrayのネスト2次元にした配列を、3行3列のセル範囲に一括転送したい
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14152979474

VBAで配列を引数・戻り値にする方法
https://qiita.com/ryosuke0825/items/93eb8a284eb5dba59f29

【マクロ】
Sub 勤務名の転置()
  '【変数】
  Dim 勤務名1(), 勤務名2() As Variant ' 勤務名
  Dim Range1_勤務() As Variant ' 転置前の縦並びの勤務名の開始セル
  Dim RangeName1() As Variant ' 転置前の縦並びの勤務名のRange名
  Dim RangeName2() As Variant ' 転置後の横並びの勤務名のRange名
  Dim Range1_勤務名() As Variant ' 転置前の縦並びの勤務名のRange
  Dim Range2_勤務名() As Variant ' 転置後の横並びの勤務名のRange
  Dim myRow1() As Variant ' 行番号
  Dim myCol1() As Variant ' 列番号
  Dim i, j As Long ' カウンタ
  '【実行コード】
  勤務名1 = Array( _
    Array("A1", "A", "A入", "A1補", "A(喀)", "2西A1", "", "", "", "", "", ""), _
    Array("C1", "C", "C入", "C1ホ", "C1補", "C1入", "受C", "", "", "", "", ""), _
    Array("C2", "C2ホ", "C2補", "", "", "", "", "", "", "", "", ""), _
    Array("夜A", "夜B", "夜C", "夜D", "夜E", "夜F", "夜A補", "夜B補", "夜C補", "夜D補", "夜E補", "夜F補"), _
    Array("休", "リ", "有", "記", "", "", "", "", "", "", "", "") _
  )
  Range1_勤務() = Array("B19", "C19", "D19", "E19", "F19") ' 転置前の縦並びの勤務名の開始セル
  RangeName1 = Array("勤務名_1", "_A1", "_C1", "_C2", "_夜勤", "_休")
  RangeName2 = Array("勤務名_2", "_A1_2", "_C1_2", "_C2_2", "_夜勤_2", "_休_2")
  Range1_勤務名 = Array("B19:F30", "B19:B24", "C19:C25", "D19:D21", "E19:E30", "F19:F22")
  Range2_勤務名 = Array("B32:M36", "B32:G32", "B33:H33", "B34:D34", "B35:M35", "B36:E36")
  ' 入れ子になっている1次元配列から2次元配列への変換
  勤務名2() = myTransArray1(勤務名1())
  ' Debug.Print "勤務名2(1,6)=" & 勤務名2(1, 6)
  Debug.Print "UBound(勤務名2,2)=" & UBound(勤務名2, 2)
  '
  myRow1 = Array(0, 0) ' 行番号配列の初期化
  myCol1 = Array(0, 0) ' 列番号配列の初期化
  ' 転置前後の勤務名の全体のセル範囲の名前付け
  Range(Range1_勤務名(0)).Name = RangeName1(0)
  Range(Range2_勤務名(0)).Name = RangeName2(0)
  ' 転置後の横並びの勤務名のセル範囲の名前付け
  For i = 0 To UBound(勤務名2, 1)
    Range(Range2_勤務名(i + 1)).Name = RangeName2(i + 1) ' 転置後の横並びの勤務名のセル範囲に名前付け
  Next i
  ' 転置前の縦並びの勤務名を各セルに代入
  For i = 0 To UBound(勤務名2, 1)
    myRow1(0) = Range(Range1_勤務(i)).Row
    myCol1(0) = Range(Range1_勤務(i)).Column
    Range(Range1_勤務名(i + 1)).Name = RangeName1(i + 1) ' 転置前の縦並びの勤務名のセル範囲に名前付け
    ' Debug.Print "myRow1(0)=" & myRow1(0)
    ' Debug.Print "myCol1(0)=" & myCol1(0)
    For j = 0 To UBound(勤務名2, 2)
      ActiveSheet.Cells(myRow1(0) + j, myCol1(0)).Value = 勤務名2(i, j)
    Next j
  Next i
  ' 勤務名の転置
  Range(RangeName2(0)).Select
  Selection.FormulaArray = "=TRANSPOSE(" & RangeName1(0) & ")"
End Sub

Function myTransArray1(ByRef myArray1() As Variant) As Variant()
  '【機能】入れ子になっている1次元配列から2次元配列への変換
  '【変数】
  Dim i, j As Long ' 整数
  Dim myArray2() As Variant ' 出力配列
  '【実行コード】
  ReDim myArray2(UBound(myArray1), UBound(myArray1(0)))
  For j = 0 To UBound(myArray1)
    For i = 0 To UBound(myArray1(0))
      myArray2(j, i) = myArray1(j)(i)
    Next i
  Next j
  myTransArray1 = myArray2()
End Function

エクセル小僧:VBAで数式を設定 [コンピューター]

エクセルで作成した勤務表において、各人が何の勤務(早番、遅番、夜勤)に何日ずつ割当たっているか計算して欲しいと依頼を受け、VBAでマクロを作ってみました。

これが、元の勤務表。
kinmu1.jpg

G列に名前、M列からAQ列まで、16日から翌月15日までの勤務が記載されています。
AS列からAY列に各勤務の数を計算する数式を設定します。

別シートに早番(A1, A)、遅番1(C1, C)、遅番2(C2)、夜勤、休みの記号を定義しています。
それぞれ、_A1, _C1, _C2, _夜勤, _休の名前を付けています。

AS列からAY列に各勤務の数を計算する数式を設定するマクロを以下に示します。
G列から名前を取得し、★、空白、カッコを取り除き、開始日を追加し、M列からAQ列のセル範囲の名前として定義します。
M列からAQ列のセル範囲に各勤務が何日あるか集計するための式をAS列からAY列に設定します。



Sub 数式編集1()
  Dim i As Integer
  Dim Name1 As String ' 名前
  Dim mySheetName1 As String ' シート名
  Dim tmpString1 As String ' 文字列
  mySheetName1 = ActiveSheet.Name ' アクティブシート名
  ' MsgBox mySheetName1
  For i = 8 To 81
    Name1 = Cells(i, 6).Value
    Name1 = Replace(Name1, "★", "") ' ★を消す
    Name1 = Replace(Name1, " ", "") ' 半角空白を消す
    Name1 = Replace(Name1, " ", "") ' 全角空白を消す
    Name1 = Replace(Name1, "(", "") ' 半角左カッコを消す
    Name1 = Replace(Name1, ")", "") ' 半角右カッコを消す
    Name1 = Replace(Name1, "(", "") ' 全角左カッコを消す
    Name1 = Replace(Name1, ")", "") ' 全角右カッコを消す
    Name1 = Name1 & "_2021_1216" ' 開始日を追加
    ' Debug.Print "名前=" & Name1
    tmpString1 = "='" & mySheetName1 & "'!R" & i & "C" & Range("M10").Column & ":R" & i & "C" & Range("AQ10").Column
    ' Debug.Print "tmpString1=" & tmpString1
    ActiveWorkbook.Names.Add Name:=Name1, RefersToR1C1:=tmpString1 ' 今月16日から来月15日までのセル範囲に名前を追加
    Range("AS" & i).Formula = "=SUMPRODUCT((ASC(" & Name1 & ")=ASC(_A1))*1)"
    Range("AT" & i).Formula = "=SUMPRODUCT((ASC(" & Name1 & ")=ASC(_C1))*1)"
    Range("AU" & i).Formula = "=SUMPRODUCT((ASC(" & Name1 & ")=ASC(_C2))*1)"
    Range("AV" & i).Formula = "=SUMPRODUCT((ASC(" & Name1 & ")=ASC(_夜勤))*1)"
    Range("AW" & i).Formula = "=SUMPRODUCT((ASC(" & Name1 & ")=ASC(_休))*1)"
    Range("AX" & i).Formula = "=COUNTA(" & Name1 & ")-SUM(AS" & i & ":AW" & i & ")"
    Range("AY" & i).Formula = "=SUM(AS" & i & ":AX" & i & ")"
  Next i
End Sub

燃えろ!

もっと燃えろ!大炎上して嵐を起こすのだ。
ヤバイぜ!(9)  コメント(1) 
共通テーマ:日記・雑感

PowerShell小僧:ファイル名の一括置換(改21) [コンピューター]

PowerShell小僧:ファイル名の一括置換(改20)
https://cheese999.blog.ss-blog.jp/2021-10-29

に最近した変更。
1.フォルダにファイルが存在しない時、置換処理を実行しない

# ファイルがあるフォルダへ移動
Set-Location -LiteralPath $MyFilePath1
$NumFile1 = (Get-ChildItem|Measure-Object).Count
if($NumFile1 -eq 0){
  Write-Host "フォルダ("$MyFilePath1")にファイルが存在しません。"
  $ErrFlg1 = $TRUE
}else{
(以下、略)

2.ファイル名を一括置換した後、Zip圧縮する、しないを選択できるようにした。

if($MyFlag1 -eq 0){
  $FlgCompZip1 = Read-HostDefault "Zip圧縮しますか? (しない/する=0/1)" $FlgCompZip1
}
# Zip圧縮
if($FlgCompZip1 -eq 1){
  $myFilePath2 = Convert-Path ".." # 1つ上のフォルダの絶対パス
  $NewFileName3 = $NewFileName1.Replace("_","") # 新しいファイル名から_を取る
  $NewFileName3 = $NewFileName3 + ".zip" # 拡張子zipをつける
  $myFilePath2 = $myFilePath2 + "\" + $NewFileName3
  myFCompZip2 -InFolderName1 $MyFilePath1 -OutZipName1 $myFilePath2 -ScriptPath1 $ScriptPath1
  if($MyFlag1 -eq 0){Read-HostDefault "OK?" > $null} # 入力待ち
}else{
  Write-Host "Zip圧縮しません。"
}

【参考】
【PowerShell】ディレクトリ、ファイル調査
https://qiita.com/MakotoIshikawa/items/96827becc4c3e5e68a56
タグ:powershell

PowerShell小僧:テキストファイル出力時の改行を制御 [コンピューター]

テキストファイルに履歴を出力する際、Set-Content, Add-Contentを使用していたのですが、最終行に余計な改行が入るため、最終行の場合は、-NoNewLineオプションで改行しないようにしました。

 最終行以外最終行
1行目Set-ContentSet-Content -NoNewLine
2行目以降Add-ContentAdd-Content -NoNewLine


【スクリプト(抜粋)】
switch ($myCNT1){
    # 初回は新規書き込み
    1{
      if($myCNT1 -ne $myLine2){
        Set-Content -Encoding UTF8 -LiteralPath $HistFile1 -Value $tmpStr1
      }else{
        # 最終行では改行しない(-NoNewline)
        Set-Content -Encoding UTF8 -NoNewline -LiteralPath $HistFile1 -Value $tmpStr1
      }
    }
    # 2回目以降は追記
    Default{
      if($myCNT1 -ne $myLine2){
        Add-Content -Encoding UTF8 -LiteralPath $HistFile1 -Value $tmpStr1
      }else{
        # 最終行では改行しない(-NoNewline)
        Add-Content -Encoding UTF8 -NoNewline -LiteralPath $HistFile1 -Value $tmpStr1
      }
    }
  }

【参考】
https://www.webdevqa.jp.net/ja/powershell/setcontent%E3%81%AF%E3%80%81%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%81%AE%E6%9C%80%E5%BE%8C%E3%81%AB%E6%94%B9%E8%A1%8C%EF%BC%88%E6%94%B9%E8%A1%8C%E3%80%81crlf%EF%BC%89%E3%82%92%E8%BF%BD%E5%8A%A0%E3%81%97%E3%81%BE%E3%81%99/832992273/

PowerShell小僧:ファイルの文字コード確認を関数化 [コンピューター]

ファイル名の一括置換スクリプトのファイルの文字コード確認部分を関数化してみた。
関数の戻り値は3つあるので、カンマ区切りの単一の配列として受け取る。

【参考】
https://inokara.hateblo.jp/entry/2016/03/11/002633

【ChangeName3_UTF8.ps1】
# 履歴ファイルの文字コード確認
$myMojiCoding1 = myFChkMojiCode1 -TargetFile1 $HistFile1
Write-Host "`$reader.Read(`$file).Name="$myMojiCoding1[0]
Write-Host "`$myMojiCoding1="$myMojiCoding1[1]
Write-Host "履歴ファイルの行数="$myMojiCoding1[2]

【myFunction1_UTF8.ps1】
# 関数:ファイルの文字コード確認
function myFChkMojiCode1{
  param(
    [Parameter(Mandatory=$true)]
    [string]$TargetFile1 # 対象ファイル
  )
  $file=Get-Item $TargetFile1
  $reader=new-object Hnx8.ReadJEnc.FileReader($file)
  [String]$ReaderName1 = $reader.Read($file).Name
  $myMojiCoding1 = myMojiCode1($ReaderName1)
  $myLine1 = (Get-Content -LiteralPath $TargetFile1|Measure-Object -Line).Lines
  return $ReaderName1,$myMojiCoding1,$myLine1
}
タグ:powershell

PowerShell小僧:スクリプトフォルダーの取得 [コンピューター]

最新版のPowerShell(7.2)をインストールしたら、エラーとなるスクリプトが出てきた。

https://docs.microsoft.com/ja-jp/powershell/scripting/whats-new/what-s-new-in-powershell-72?view=powershell-7.2

調べると、以下の記述のところらしい。

$ScriptPath1 = Split-Path $MyInvocation.MyCommand.Path -Parent

スクリプトフォルダーの取得方法には、もう1つ方法あって、$PSScriptRootでもいいらしい。そこでエラーとなる記述を次の様に変更した。

if($PSVersionTable.PSVersion.Major -ge 3){
  $ScriptPath1 = $PSScriptRoot
}else{
  $ScriptPath1 = Split-Path $MyInvocation.MyCommand.Path -Parent
}

【参考】
https://www.vwnet.jp/Windows/PowerShell/pwd.htm

とりあえず、この変更でエラーは回避できた。

PowerShell小僧:スペースを含むフォルダ名 [コンピューター]

ファイル名のみならず、フォルダ名に含まれるスペースもアンダーバーに変更するようにスクリプトを書き換えてみました。

フォルダ名を変更した場合、ファイル・フォルダの一覧を取得し直す様にしています。

スクリプトはこちら。。。


PowerShell小僧:スペースを含むファイル名 [コンピューター]

次のコマンドレットの$NewItem1にスペースを含むファイル名(フルパス)を与えるとエラーになります。

$NewItem1 = "C:\aaa\bbb\cc dd.txt"
$ScriptFile1 = $ScriptPath1 + "\nkf_UTF8wBOM1.ps1 -TargetFile1 $NewItem1 -ScriptPath1 $ScriptPath1"

そこで、$NewItem1に含まれるスペースをアンダーバーに変換することでエラーを回避します。

$NewItem1 = "C:\aaa\bbb\cc dd.txt"
$NewItem2 = myFRnSpToUBar1 -TargetFile1 $NewItem1
$ScriptFile1 = $ScriptPath1 + "\nkf_UTF8wBOM1.ps1 -TargetFile1 $NewItem2 -ScriptPath1 $ScriptPath1"

# 関数:ファイル名の空白をアンダーバーに変換
function myFRnSpToUBar1{
  param (
    [Parameter(Mandatory=$true)]
    [String]$TargetFile1 # 対象ファイル
  )
  # ドットソース演算子
  # .{}の中の標準出力は戻り値に含めない
  .{
    $NewFileName1 = (Get-ChildItem -Path ($TargetFile1)).Name -replace '\s','_'
    $ParentPath1 = Split-Path $TargetFile1 -Parent
    $NewFilePath1 = $ParentPath1 + "\" + $NewFileName1
    Write-Host "`$NewFilePath1=$NewFilePath1"
    # ファイル名置換(空白→アンダーバー)
    get-childitem $TargetFile1|Rename-Item -NewName { $_.Name -replace '\s','_' }
  }>$null
  Return $NewFilePath1
}

PowerShell小僧:ファイル名の一括置換(改20) [コンピューター]

PowerShell小僧:ファイル名の一括置換(改19)
https://cheese999.blog.ss-blog.jp/2021-10-25

に以下の変更をしました。

1.zipファイルの中身を確認する際のフォルダを示すファイル属性の正規表現を変更

【Extract1.ps1】
./7z l $InZip1 | Tee-Object -Variable Result7Zip # zipファイルの中身を確認
# 解凍後に出力されるフォルダの行を抽出 例:"D....","D...A"
$myList1 = ($Result7Zip | select-string -pattern "\sD[A-CE-Z\.]{4}\s")

理由:ファイル属性が"D...."のみではなく、"D...A"等の場合もあるため

2.zip圧縮後に、フォルダ削除するとき、Remove-Itemコマンドレットに-Force -ErrorAction Stopオプションを追加

【Compress1.ps1】
Remove-Item -Path $InFolder1 -Recurse -Force -ErrorAction Stop

理由:フォルダ内が空ではない、というエラーでRemove-Itemコマンドレットが実行されない場合があるため、エラーがあっても強制実行するようにした。

今回、変更後のスクリプト(全部)の掲載は省略します。

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。