空の行の値を一方の側に移動し、空でない値をもう一方の側に移動できるVBscriptが必要です。これは、ループ手法を使用して実行できます。しかし、VBscriptを使用して実装できる場合は、より高速なプロセスが必要です。
入力シート
Code Error-I Error-II Error-III
Type-1 Type-2 Type-3 Test-A Test-B Test-C Prog-A Prog-B Prog-C
Code-A Yes No Yes X Z
Code-B No Yes Yes Y Z
Code-C Yes Yes No Z
出力シート
Code Error-I Error-II Error-III
Type-1 Type-2 Test-A Test-B Prog-A Prog-B
Code-A Yes No Yes X Z
Code-B No Yes Yes Y Z
Code-C Yes Yes No Z
更新:グループ内の列に単一のデータが含まれていないことが判明した場合にシフトした後、その列をシートから削除する必要があります。
すべての列セットに対して以下のコードを記述しましたが、誤ったデータシフトが発生しています。どこが間違っていたのか教えていただけますか?
Option Explicit
Dim objExcel1
Dim strPathExcel1
Dim objSheet1
Dim row,col1,col2
Dim TotlColumnSet : TotlColumnSet =3
Dim AssColmuns : AssColmuns=3
Dim EachColumnSet, ColStart, ColEnd
Set objExcel1 = CreateObject("Excel.Application")
strPathExcel1 = "D:\VA\Copy of Test.xlsx"
objExcel1.Workbooks.open strPathExcel1
Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(1)
ColStart = 2
For EachColumnSet = 1 To TotlColumnSet
For row = 3 To 5
' find the first empty cell in the row
col1 = ColStart'2
ColEnd = ColStart + AssColmuns
Do Until IsEmpty(objSheet1.Cells(row, col1)) Or col1 > ColEnd-1'4
col1 = col1 + 1
Loop
' collapse right-hand cells to the left
If col1 < ColEnd-1 Then '4
' proceed only if first empty cell is left of the right-most cell
' (otherwise there's nothing to do)
col2 = col1 + 1
Do Until col2 > ColEnd-1'4
' move content of a non-empty cell to the left-most empty cell, then
' increment the index of the left-most empty cell (the cell right of
' the former left-most empty cell is now guaranteed to be empty)
If Not IsEmpty(objSheet1.Cells(row, col2).Value) Then
objSheet1.Cells(row, col1).Value = objSheet1.Cells(row, col2).Value
objSheet1.Cells(row, col2).Value = Empty
col1 = col1 + 1
End If
col2 = col2 + 1
Loop
End If
Next
ColStart = ColEnd
Next
'=======================
objExcel1.ActiveWorkbook.SaveAs strPathExcel1
objExcel1.Workbooks.close
objExcel1.Application.Quit
'======================
アップデート:
間違いにより、出力テーブルの列Type-3、Test-C、Prog-Cに表示されませんでした。しかし、彼らはそこにいる必要があります。