次のような表があるとします。
A B
C D
E F
セル B を削除すると、すべてのセルが次のように A に向かって 1 つずつ移動します。
A C
D E
F
これを実現するにはどうすればよいでしょうか。また、その逆、つまりどこかに 1 つのセルを挿入し、他のすべてのセルを 1 か所に移動するにはどうすればよいでしょうか。
答え1
数日前、knezmilos さんが求めていたようなものが必要でしたが、それを実現する方法が見つかりませんでした。そこで、それを実現する VBA マクロ (Word 2016) を作成しました。マクロは 4 つの異なる方法で動作します。
- すべてのセルを表の最後まで右に移動します (Public Sub MoveCellsRight)
- 最初の空白セルまですべてのセルを右にシフトします (Public Sub MoveCellsRightFirstBlankCell)
- すべてのセルを表の先頭まで左に移動します (Public Sub MoveCellsLeft)
- 最初の空白セルまですべてのセルを左にシフトします (Public Sub MoveCellsLeftFirstBlankCell)
このマクロしない:
- セル内のテーブルを操作します。
- 分割されたセルを操作します (各行の列数は同じである必要があります)。
- セルの書式を保持します。(誰かがこの機能を追加してこのマクロを改善してくれることを願っています)。
マクロは次のとおりです:
Option Explicit
Dim vmCurrentTableIndex As Integer
Dim vmCurrentTableRowCount As Integer
Dim vmCurrentTableColCount As Integer
Dim vmCurrentCellRow As Integer
Dim vmCurrentCellCol As Integer
Dim vmDirection As String
Enum StopCellMode
FirstLastCell = 0
FirstBlankCell = 1
End Enum
Public Sub MoveCellsRight()
If SetModuleVariables("right") Then
If CheckCurrentCellPosition() Then
MoveCellContent (FirstLastCell)
End If
End If
End Sub
Public Sub MoveCellsLeft()
If SetModuleVariables("left") Then
If CheckCurrentCellPosition() Then
MoveCellContent (FirstLastCell)
End If
End If
End Sub
Public Sub MoveCellsRightFirstBlankCell()
If SetModuleVariables("right") Then
If CheckCurrentCellPosition() Then
MoveCellContent (FirstBlankCell)
End If
End If
End Sub
Public Sub MoveCellsLeftFirstBlankCell()
If SetModuleVariables("left") Then
If CheckCurrentCellPosition() Then
MoveCellContent (FirstBlankCell)
End If
End If
End Sub
Private Function SetModuleVariables(vpDirection As String) As Boolean
Dim vsOK As Boolean
Dim vsMsgBoxValue As Integer
'Check if the [cursor | insertion point] is inside a table.
If ActiveDocument.ActiveWindow.Selection.Information(wdWithInTable) Then
vsOK = True
'Get the index of the current table. / Source: https://wordmvp.com/FAQs/MacrosVBA/GetIndexNoOfPara.htm
vmCurrentTableIndex = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
vmCurrentTableRowCount = ActiveDocument.Tables(vmCurrentTableIndex).Rows.Count
vmCurrentTableColCount = ActiveDocument.Tables(vmCurrentTableIndex).Columns.Count
vmCurrentCellRow = ActiveDocument.ActiveWindow.Selection.Cells(1).RowIndex
vmCurrentCellCol = ActiveDocument.ActiveWindow.Selection.Cells(1).ColumnIndex
vmDirection = vpDirection
Else
vsMsgBoxValue = MsgBox("This command can be executed only within a table.", vbInformation, "Error")
vsOK = False
End If
SetModuleVariables = vsOK
End Function
Private Function CheckCurrentCellPosition() As Boolean
Dim vsOK As Boolean
Dim vsMsgBoxValue As Integer
vsOK = True
If vmDirection = "right" Then
If vmCurrentCellRow = vmCurrentTableRowCount And vmCurrentCellCol = vmCurrentTableColCount Then
vsMsgBoxValue = MsgBox("This is the last cell. There is no cell to move to the right.", vbCritical, "Error")
vsOK = False
End If
Else
If vmCurrentCellRow = 1 And vmCurrentCellCol = 1 Then
vsMsgBoxValue = MsgBox("This is the first cell. There is no cell to move to the left.", vbCritical, "Error")
vsOK = False
End If
End If
CheckCurrentCellPosition = vsOK
End Function
Private Sub MoveCellContent(vpStopCellMode As StopCellMode)
Dim vsCol As Integer
Dim vsRow As Integer
Dim vsStartRow As Integer
Dim vsStartCol As Integer
Dim vsEndRow As Integer
Dim vsEndCol As Integer
Dim vsStep As Integer
Dim IsStartColSet As Boolean
Dim vsCurrentCellContent As String
Dim vsPreviousCellContent As String
Dim vsLenght As Integer
vsPreviousCellContent = ""
IsStartColSet = False
vsStartRow = vmCurrentCellRow
vsStartCol = vmCurrentCellCol
If vmDirection = "right" Then
vsStep = 1
vsEndRow = vmCurrentTableRowCount
vsEndCol = vmCurrentTableColCount
Else
vsStep = -1
vsEndRow = 1
vsEndCol = 1
End If
For vsRow = vsStartRow To vsEndRow Step vsStep
For vsCol = vsStartCol To vsEndCol Step vsStep
vsLenght = Len(ActiveDocument.Tables(vmCurrentTableIndex).Cell(vsRow, vsCol).Range.Text) - 2
vsCurrentCellContent = Left(ActiveDocument.Tables(vmCurrentTableIndex).Cell(vsRow, vsCol).Range.Text, vsLenght)
ActiveDocument.Tables(vmCurrentTableIndex).Cell(vsRow, vsCol).Range.Text = vsPreviousCellContent
vsPreviousCellContent = vsCurrentCellContent
If vsCurrentCellContent = "" And vpStopCellMode = FirstBlankCell Then
Exit Sub
End If
Next
If IsStartColSet = False Then
If vmDirection = "right" Then
vsStartCol = 1
Else
vsStartCol = vmCurrentTableColCount
End If
IsStartColSet = True
End If
Next
End Sub
答え2
回答の試み:
次のマクロを記述します:
- 表の最後のセルの別のコピーを表の下に作成し、
- コピーしたセルをテーブルから削除し、
- 繰り返しの準備をするために、カーソルを最後の残りのセルに戻します。
テストしてから、table-inter-alignment の境界線の間隔を削除し
、境界線のレンダリングを調整して、機能するデザイン/外観を取得します。
(試していません)
マクロの記録に役立つように、LibreOffice (v5.1.6.2) Writer で次のことを試します。
注: 私はこれをWriteで記録しようとしているのではなく、Writeと同じキーバインディングがあると仮定してWordでどのように機能するかを示しているだけです。現時点ではWordにアクセスできません。 これは問題に適用する思考の例であり、質問に対する具体的な答えを試みているわけではありません。
メニュー > 表 > 表の挿入 (CTRL+F12)、デフォルトは 2x2 表です...
少なくとも最後の 2 行のセル内にテキスト行を入力します。
テーブルを終了するにはカーソルを下へ押し、テーブルと貼り付ける内容の間に少なくとも 1 行追加するには Enter キーを押します。
以下の説明は「高度」であるように思われるかもしれませんが、実際の操作はそうではありません。
記録は、最後の行のセルがコピーされたところから開始する必要があります。つまり、
- Ctrl キーを押しながらカーソルを 2 回上に押します。
カーソルは表の最後の行の右セルの左上 (開始点) にあります。 - 録音を開始する(Wordで使用する場合)
- メニュー > テーブル > テーブルを分割を選択します
(最後のテーブル行が別のテーブルに分割されます) - 次に、CTRL キーと SHIFT キーを押しながら End キーを 2 回押して、
1 行 2 列の表の右側のセル全体を書き込みます。 - Ctrlキーを押しながらXを押すとコンテンツを切り取ることができます
- CTRL+SHIFTを押しながらHomeキーを押すと
両方のセルが選択されます - メニュー > 表 > セルの結合を選択
- カーソルを2行下に移動して貼り付けます(CTRL+V)
- Ctrl キーを押しながら、カーソルが上記の手順 1) の後と同じ位置になるまで、カーソルを 1 ステップずつ上に移動します。
- 記録を停止します (Word 使用時)。
テーブルの最後の行は、それぞれ 1 つのセルを持つ 2 つの別々の「テーブル」に抽出されました。
マクロにショートカット キーを割り当てると、実行できるようになります。ここでの簡単な操作は、マクロがテーブルを「消費」している間、座ってマクロを保持することです。おそらく、大きなテーブルの場合は数分、さらに大きいテーブルの場合はさらに長くなります。