Excel (一般機能)

Excelの一般機能に関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Home : Microsoft 365)
フィルターで抽出した行だけに列挿入したい。
投稿日時: 25/01/26 15:04:06
投稿者: mild2

データ一覧表で特定の行のデータのみ列が1列ズレていたのでそれを修正するために、まず特定の行のみフィルターで抽出しました。その状態で1列挿入した後にフィルターを解除したら特定行だけでなく全行に渡って1列挿入されました。フィルターで抽出した特定の行にだけ列挿入したい場合、どうしたら出来ますでしょうか?

回答
投稿日時: 25/01/26 16:07:29
投稿者: んなっと

こういうことなら
 
   A   B   C  D
 1 No. 空欄 分類 値
 2 101     あ 10
 3 102     あ 11
 4 103  い  12  
 5 104  い  13  
 6 105     あ 14
 7 106     あ 15
 8 107  い  16  
 9 108  い  17  
10 109     あ 18
 
 い のセルだけを選択
→(フィルターは解除した状態で)セルの挿入[右方向にシフト]

投稿日時: 25/01/26 21:31:24
投稿者: mild2

んなっとさん、いつも的確なご回答ありがとうございます。
はい、今回も私の目的を的確に把握して頂きました。
やはりフィルターで抽出した状態では列挿入は列全体の挿入しか出来ないんですかね?
そうであるならば諦めざるを得ないですかね?
 
 

投稿日時: 25/01/26 21:33:05
投稿者: mild2

関連質問です。パワークエリで結合と変換の途中でも同様の症状(特定の行データで列がズレている)が散見されるときがあるのですが、パワークエリでも今回の質問のように特定の行のみ抽出した状態でその抽出した行のみに列挿入は出来ないでしょうか?

回答
投稿日時: 25/01/27 08:47:29
投稿者: んなっと

表形式の具体例を示さない質問には、手抜き回答をします。
 
これを
 
   A   B   C  D
 1 No. 空欄 分類 値
 2 101     あ 10
 3 102  い  11  
 4 103  い  12  
 5 104     あ 13
 6 105     あ 14
 7 106  え  15  
 8 107     あ 16
 9 108     う 17
10 109     う 18
 
↓ こうしたいなら
 
   A   B  C
 1 No. 分類2 値2
 2 101   あ  10
 3 102   い  11
 4 103   い  12
 5 104   あ  13
 6 105   あ  14
 7 106   え  15
 8 107   あ  16
 9 108   う  17
10 109   う  18
 
詳細エディターで
 
let
    ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content],
    Add = Table.AddColumn(ソース, "分類2", each if [空欄] = null then [分類] else [空欄], type any),
    Add2 = Table.AddColumn(Add, "値2", each if [空欄] = null then [値] else [分類], type any),
    Del = Table.RemoveColumns(Add2,{"空欄", "分類", "値"})
in
    Del
 
[列の追加]→[例からの列]→[選択した範囲から]を活用すれば、
自分でも上のような式が作れます。勉強して試行錯誤しましょう。

投稿日時: 25/01/30 12:52:07
投稿者: mild2

詳細エディターでは出来ましたが
[列の追加]→[例からの列]→[選択した範囲から]ではうまく出来ませんでした。
試行錯誤しています。

回答
投稿日時: 25/01/30 21:39:12
投稿者: んなっと

がんばってください。
   
ちなみに、すべての空欄をスキップして左詰めにし、
   
   A   B  C   D   E
 1 No. 分類 値 空欄 空欄2
 2 101    あ      10
 3    102 い      11
 4    103 い  12    
 5 104    あ  13    
 6 105    あ  14    
 7 106  え 15       
 8    107 あ      16
 9    108 う      17
10    109 う      18
   
  ↓最初の3列だけにしたいときは...
   
   A   B  C
 1 No. 分類 値
 2 101  あ 10
 3 102  い 11
 4 103  い 12
 5 104  あ 13
 6 105  あ 14
 7 106  え 15
 8 107  あ 16
 9 108  う 17
10 109  う 18
   
 詳細エディター
   
let
    ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content]
in
    ソース
   
 のletのすぐ下に赤字部分の関数を挿入
→in のすぐ上に MltDel(   ,3) で一つ上のステップをで挟んだ行追加
→in のすぐ下も変更
 
let
    MltDel=(Prm,Cnt)=>
        let Clm = List.FirstN(Table.ColumnNames(Prm),Cnt),
            Add = Table.AddColumn(Prm, "Custom", each
                let a = Record.ToList(_),
                    b = List.RemoveNulls(a),
                    c = List.Combine({b,List.Repeat({null},Cnt)}),
                    d = List.FirstN(c,Cnt),
                    e = Record.FromList(d,Clm)
                in e),
            Del = Table.SelectColumns(Add,{"Custom"}),
            Exp = Table.ExpandRecordColumn(Del, "Custom", Clm)
        in Exp,

    ソース = Excel.CurrentWorkbook(){[Name="テーブル1"]}[Content],
    Del2 = MltDel(ソース,3)
in
    Del2

投稿日時: 25/01/31 16:22:20
投稿者: mild2

んなっとさん、ありがとうございます。
昨年だったと思います。エクセルのデータを普通にコピペしてここに投稿したら列がずれますが、ずれない方法を教えて頂きました。その昨年のやり取りを探しましたが見つけられないのです。恐れ入りますが再度お教え頂けませんでしょうか?

回答
投稿日時: 25/01/31 16:49:49
投稿者: んなっと

メッセージにExcelシートのデータを取り込みましょう!
https://www.moug.net/faq/info_q.html#q5_2
 
加えて、半角スペースが2個以上連続すると勝手に縮められてしまうことにも注意してください。
必要であれば全角スペースで位置を調整し、半角スペースは単体で使って微調整しましょう。

回答
投稿日時: 25/01/31 16:55:44
投稿者: んなっと

VBAを使える環境なら
 
Sub セル範囲をクリップボードに()
  Dim myRng As Range
  Dim n As Long
  Dim cntCol As Long
  Dim cntRow As Long
  Dim myMax() As Long
  Dim myVar() As String
  Dim myStr As String
  Dim myFormula As String
  Dim flgFormula As Boolean
  Dim i As Long
  Dim j As Long
  Dim Filj As String
  Dim Sepj As String
  Dim meNum As Variant
  Dim myFlg As Boolean
  Dim ForConFlg As Boolean
  Dim myData As Object
  Set myData = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  If TypeName(Selection) <> "Range" Then
    MsgBox "セル範囲選択して!"
    Exit Sub
  End If
  Filj = " " '半角スペース
  Sepj = " " '全角スペース
  'フィルコピー方向指定
  myFlg = False
  Do
    meNum = CVar(InputBox("1〜3の番号入れて" & _
        Chr(13) & "0:数式なし" & _
        Chr(13) & "1:数式すべて貼り付け" & _
        Chr(13) & "2:下方向・↓" & _
        Chr(13) & "3:右方向・→", _
        "フィルコピー方向指定", "2"))
    If meNum = "" Then Exit Sub
    If meNum > 3 Or meNum < 0 Then
      MsgBox "0〜3の番号入れて", vbOKOnly
      Else: myFlg = True
    End If
  Loop While myFlg = False
  With Selection
    For n = 1 To .Areas.Count
      Set myRng = .Areas(n)
      With myRng
        cntCol = .Columns.Count
        cntRow = .Rows.Count
        ReDim myMax(cntCol)
        ReDim myVar(cntRow, cntCol)
        myVar(0, 0) = Filj '半角スペース
        For i = 1 To cntRow
          myVar(i, 0) = .Item(i, 1).Row
        Next i
        myMax(0) = LenB(StrConv(myVar(cntRow, 0), vbFromUnicode))
        For j = 1 To cntCol
          flgFormula = False
          myVar(0, j) = Left$(.Item(1, j).Address(False, False), 1)
          For i = 1 To cntRow
            With .Item(i, j)
              If .Text = "" Or .Font.ColorIndex = 2 Then
                myVar(i, j) = Filj '半角スペース
              Else
                myVar(i, j) = .Text
              End If
              If meNum = 1 Or meNum = 2 Then
                If flgFormula = False And .HasFormula Then
                  myFormula = myFormula & _
                          .Address(False, False) & vbCrLf & _
                          .Formula & vbCrLf
                  If .HasArray = True Then
                    myFormula = myFormula & _
                        "Ctrl+Shift+Enter同時押し" & vbCrLf
                  End If
                  If meNum = 2 Then
                    myFormula = myFormula & _
                          "下方向・↓" & vbCrLf
                    flgFormula = True
                  End If
                End If
                On Error Resume Next
                  myFormula = myFormula & _
                    .Address(False, False) & vbCrLf & _
                    "入力規則:リスト▼:元の値:" & vbCrLf & _
                    .Validation.Formula1 & vbCrLf
                On Error GoTo 0
                If ForConFlg = False And .FormatConditions.Count > 0 Then
                  myFormula = myFormula & _
                    .Address(False, False) & vbCrLf & _
                    "条件付書式:数式を使用して〜▼" & vbCrLf & _
                    .FormatConditions(1).Formula1 & vbCrLf
                  ForConFlg = True
                End If
              End If
            End With
            If myMax(j) < LenB(StrConv(myVar(i, j), vbFromUnicode)) Then
              myMax(j) = LenB(StrConv(myVar(i, j), vbFromUnicode))
            End If
          Next i
        Next j
        For i = 0 To cntRow
          flgFormula = False
          For j = 0 To cntCol
            myStr = myStr & String(myMax(j) - _
              LenB(StrConv(myVar(i, j), vbFromUnicode)), Filj) _
              & myVar(i, j) & String(2, Filj) '半角スペース2個
            If meNum = 3 Then
              If i > 0 And j > 0 Then
                With .Item(i, j)
                  If flgFormula = False And .HasFormula Then
                    myFormula = myFormula & _
                            .Address(False, False) & vbCrLf & _
                            .Formula & vbCrLf
                    If .HasArray = True Then
                      myFormula = myFormula & _
                          "Ctrl+Shift+Enter同時押し" & vbCrLf
                    End If
                    myFormula = myFormula & _
                          "右方向・→" & vbCrLf
                    flgFormula = True
                  End If
                End With
              End If
            End If
          Next j
          myStr = Left$(myStr, Len(myStr) - 1) & vbCrLf
        Next i
      End With
    Next n
  End With
  myStr = Replace(myStr, String(2, Filj), Sepj) '半角スペース2個を全角スペースに
  myStr = myStr & vbCrLf & myFormula
  Set myData = GetObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  With myData
    .SetText myStr
    .PutInClipboard 'クリップボードに
  End With
  Set myData = Nothing
End Sub

投稿日時: 25/01/31 17:55:22
投稿者: mild2

んなっとさん、昨年のデータ提供ありがとうございました。
 
VBAはまだまだ遠い存在です。
まずは詳細エディターで出来ましたので、何とかなりました。
 
ありがとうございました。