シート1に別のシートから抽出した人名が並んでいます。
シート2にも別のシートから抽出した数字が並んでいます。
人名と数字は同じ行/列に格納されます。
シート1もシート2も空白が含まれています。
シート3に人名と数値を隣り合わせで格納したいのです。
シート1とシート2共に、「並び替えとフィルター」を使って空白以外を
抽出したいのですが、「昇順/降順」を使うと、人名と数字の関連が崩れる
ので困っています。
「並び替えとフィルター」で不可能ならば、別な方法でも構いません。
ご教示いただけますようお願い致します。
シート1 シート2
A B C D A B C D
1 太郎 次郎 1 100 10
2 三郎 花子 春子 2 5 200 50
3 秋子 夏子 3 500 100
4 四郎 五郎 六郎 4 80 300 400
5 七郎 冬子 5 300 60
シート3
A B C D E F G H
1 太郎 100 花子 200 次郎 10 春子 50
2 三郎 5 五郎 300 秋子 500 夏子100
3 四郎 80 六郎 400 冬子 400
4 七郎 300
5
No.9ベストアンサー
- 回答日時:
No8の回答の補足です。
質問の流れを見ると、元データがすべて数式で表示されているのでしょうか。
この場合は、NO8の回答では数式セルがすべて選択されてしまう可能性が高いので、空白に見えるセルだけ選択するには、以下のような手順でデータ処理する必要があります。
すなわち、元データを選択して右クリック「コピー」、シート3で右クリック「形式を選択して貼り付け」で「値」で貼り付けて数式をすべて値に変更しておきます。
このようにすると空白に見えるセルには空白文字列が入力されていますので(実際の空白セルではないので)、以下のような手順で空白文字列セルをすべて選択して、No8の回答の手順で空白文字列セルを一括削除することができます。
すなわち、1つの空白文字列セルを選択して、右クリックコピー、Ctrl+Fで検索ダイアログを出して、そのまま検索する文字列の欄にCtrl+Vで空白文字列を貼り付けてから「すべて検索」してCtrl+Aで該当セルをすべて選択して右クリックから「削除」してください。
この回答への補足
何度もご指導いただき本当にありがとうございました。
お蔭でこの方法で目的を達成することができました。
重ねてお礼を申し上げますと共に深いご見識に敬意を表します。
度々のご助言本当にありがとうございます。
No.7を実行しましたが、まだ、ダメそうです。
No.9方式の方向で検討させていただきます。
「値」で貼り付けて数式をすべて値に変更することができましたので、これで大丈夫そうです。
今夜も仕事なのでこれから仮眠をとります。
結果は別途報告させていただきます。
No.8
- 回答日時:
>『データ範囲を選択し、Ctrl+Gでジャンプダイアログを出して、「セル選択」「空白セル」で「OK」し、そのまま右クリックから「削除」から「上方向にシフト」を選択します。
』これが知りたかったポイントです。
本当の空白セルではなく、数式の「""」の空白表示のセルを削除したいなら以下のような手順で簡単に見掛けの空白セルを削除できます。
データ範囲を選択して、Ctrl+Fのショートカット操作で検索ダイアログを出して、検索する文字列に「""」を入力して「すべて検索」し、その後Ctrl+Aのショートカット操作で、空白に見えるセルをすべて選択し、右クリックから「削除」で「上方向にシフト」してください。
もし、上記の回答でうまくいかない場合は、データの詳細を補足説明してください。
No.7
- 回答日時:
何度もごめんなさい。
前回のコードで一部不備がありました。
If Worksheets.Count < 4 Then
Worksheets.Add after:=wS3
Set wS4 = Worksheets(4)
End If
の4行を
If Worksheets.Count < 4 Then
Worksheets.Add after:=wS3
End If
Set wS4 = Worksheets(4)
に訂正してください。
Sheet見出しに4個以上のSheetが存在した場合は前回のコードではうまく動きません。
これが最後になれば良いのですが・・・m(_ _)m
No.6
- 回答日時:
何度もお邪魔します。
>実行に30分以上かかってしまいました。
というコトはかなりのデータ量だと思いますので、いままでのように各セルを舐めるように検索していたのでは
話にならないと思います。
別の方法にしてみました。
尚、Sheet4を作業用のSheetとして使用していますが、Sheet見出し上に3Sheet分だけ表示されていれば
マクロが動くようにしています。
いままでのコードはすべて無視して↓のコードにしてマクロを実行してみてください。
(今回も標準モジュールです)
Sub Sample4()
Dim j As Long, endRow As Long, endCol As Long
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet, wS4 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
Application.ScreenUpdating = False
On Error Resume Next
wS3.Cells.Clear
If Worksheets.Count < 4 Then
Worksheets.Add after:=wS3
Set wS4 = Worksheets(4)
End If
endRow = wS1.UsedRange.Rows.Count
endCol = wS1.UsedRange.Columns.Count
For j = 1 To endCol
Range(wS1.Cells(1, j), wS1.Cells(endRow, j)).Copy wS3.Cells(1, j * 2 - 1)
Next j
endRow = wS2.UsedRange.Rows.Count
endCol = wS2.UsedRange.Columns.Count
For j = 1 To endCol
Range(wS2.Cells(1, j), wS2.Cells(endRow, j)).Copy wS3.Cells(1, j * 2)
Next j
endRow = wS3.UsedRange.Rows.Count
endCol = wS3.UsedRange.Columns.Count
With Range(wS3.Cells(1, 1), wS3.Cells(endRow, endCol))
.Value = .Value
End With
endRow = wS3.UsedRange.Rows.Count
endCol = wS3.UsedRange.Columns.Count
For j = 1 To endCol
Range(wS3.Cells(1, j), wS3.Cells(endRow, j)).Cut wS4.Cells(1, 1)
With Range(wS4.Cells(1, "B"), wS4.Cells(endRow, "B"))
.Formula = "=IF(A1="""",2,1)"
.Value = .Value
End With
wS4.Range("A1").CurrentRegion.Sort key1:=wS4.Range("B1"), order1:=xlAscending, Header:=xlNo
wS4.Range("A:A").Copy wS3.Cells(1, j)
wS4.Range("A:B").Clear
Next j
Application.DisplayAlerts = False
Worksheets(4).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "処理完了"
End Sub
こんどはどうでしょうか?m(_ _)m
No.5
- 回答日時:
たびたびお邪魔します。
結局最初の方法でよいと思うのですが、
もしかして空白セルは数式が入っていて空白に見えている!
というコトはないでしょうか?
もしそうであれば数式が入っていて空白に表示されているセルはそのまま残ってしまいますので、
別案として・・・
Sub Sample3()
Dim i As Long, j As Long, endRow As Long, endCol As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
Application.ScreenUpdating = False
With Worksheets("Sheet3")
.Cells.Clear
For j = 1 To wS1.UsedRange.Columns.Count
wS1.Columns(j).Copy .Cells(1, j * 2 - 1)
Next j
For j = 1 To wS2.UsedRange.Columns.Count
wS2.Columns(j).Copy .Cells(1, j * 2)
Next j
endRow = .UsedRange.Rows.Count
endCol = .UsedRange.Columns.Count
For i = endRow To 1 Step -1
For j = 1 To endCol
If .Cells(i, j) = "" Then
.Cells(i, j).Delete shift:=xlUp
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub
今度はうまく動けばよいのですが・・・m(_ _)m
私の説明不足で何度もお手数をお掛けしました。
ご指摘通り「空白セルは数式が入っていて空白に見えている!」です。
ご提示いただいたマクロで目的の形を実現することができました。
本当にありがとうございました。
但し、Excelの容量が大きいことやCPUパワーが低いこともあり、実行に30分以上かかってしまいました。
残念ながら、これでは実際には使えないので、シート1とシート2をそれぞれ、単純に上詰めすることができればあとは何とかできます。
度々で大変恐縮ですが、お知恵を拝借できますよう重ねてお願い申し上げます。
補足:これまではシート1のみであり、「並び替え」を使ってソート(マクロ記録)していたのですが、シート2と連動させる必要がでてきて、シート2は数字なので、降順/昇順を使うとうまく、シート1と連動しないので困っています。
シート1とシート2の見かけ上の空白セルを取り除いて上詰めできれば解決します。
No.4
- 回答日時:
No.3です。
>各列毎に空白行を取り除いて、頭詰めすることはできるでしょうか?
すなわち列も空白は削除して左詰めしたい!というコトでしょうかね?
もしそうであれば↓のコードに変更してみてください。
※ 1行だけの追加ですが、どの行に!というよりもう一度最初からのコードを載せますので
前回のコードはすべて削除して新たにコピー&ペーストしてみてください。
Sub Sample2() 'この行から
Dim j As Long, endRow As Long, endCol As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet3")
.Cells.Clear
For j = 1 To wS1.UsedRange.Columns.Count
wS1.Columns(j).Copy .Cells(1, j * 2 - 1)
Next j
For j = 1 To wS2.UsedRange.Columns.Count
wS2.Columns(j).Copy .Cells(1, j * 2)
Next j
endRow = .UsedRange.Rows.Count
endCol = .UsedRange.Columns.Count
On Error Resume Next '←お・ま・じ・な・い!
Range(.Cells(1, 1), .Cells(endRow, endCol)).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft '←この行を追加
End With
Application.ScreenUpdating = True
End Sub 'この行まで
今度はどうでしょうか?m(_ _)m
No.3
- 回答日時:
こんばんは!
VBAになってしまいますが、一例です。
Sheet1とSheet2のデータは行・列とも一致しているという前提です。
(例)「太郎」がSheet1のA1にあれば、それに対応するデータがSheet2の同じセル番地に存在する
Alt+F11キー → メニュー → 挿入 → 標準モジュール → VBE画面に
↓のコードをコピー&ペーストしてマクロを実行してみてください。
(Alt+F8キー → マクロ → マクロ実行です)
Sub Sample1() 'この行から
Dim j As Long, endRow As Long, endCol As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("Sheet1")
Set wS2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Worksheets("Sheet3")
.Cells.Clear
For j = 1 To wS1.UsedRange.Columns.Count
wS1.Columns(j).Copy .Cells(1, j * 2 - 1)
Next j
For j = 1 To wS2.UsedRange.Columns.Count
wS2.Columns(j).Copy .Cells(1, j * 2)
Next j
endRow = .UsedRange.Rows.Count
endCol = .UsedRange.Columns.Count
On Error Resume Next '←お・ま・じ・な・い!
Range(.Cells(1, 1), .Cells(endRow, endCol)).SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
End With
Application.ScreenUpdating = True
End Sub 'この行まで
こんな感じではどうでしょうか?m(_ _)m
高度なご回答をいただき、感激しています。
早速、実行してみましたところ、Sheet1とSheet2の内容が綺麗に並びました。
しかし、行は元のままでした。
各列毎に空白行を取り除いて、頭詰めすることはできるでしょうか?
申し訳ございませんが、もう少しお知恵を拝借できると大変助かります。
No.2
- 回答日時:
ブランクのマクロを作り、それにしたのマクロをコピーはり付けした後、このマクロを実行させるとシート3の各セルに、対応するシート1とシート2のデータをつないだデータが入っています。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2013/11/6 ユーザー名 :
'
Dim i As Integer, j As Integer
'
For i = 1 To 2
For j = 1 To 4
Worksheets(3).Cells(i, j) = Worksheets(1).Cells(i, j) & Worksheets(2).Cells(i, j)
Next
Next
End Sub
No.1
- 回答日時:
ご希望の操作は以下のような手順で行うことができます。
まずシート1とシート2のシート名部分をCtrlキーを押しながらクリックして作業グループにして、B列を選択して、右クリック「挿入」、同様にD列をクリックして右クリック「挿入」の操作を繰り返し、1列ごとに空白列の空いたリストを作成します。
次にデータ範囲を選択し、Ctrl+Gでジャンプダイアログを出して、「セル選択」「空白セル」で「OK」し、そのまま右クリックから「削除」から「上方向にシフト」を選択します。
最後にシート名を右クリックして「作業グループの解除」を行い、シート2のデータ範囲を選択し、右クリック「コピー」から、シート1のB1セル(数字データを入力する1つ右のセル)を選択し、右クリック「形式を選択して貼り付け」で「空白セルを無視する」にチェックを入れて「すべて」を貼り付けてください。
ちなみにシート1とシート2のデータを残したい場合は、シート3上にデータをコピーして同様な作業をすることになります(このケースでは列を挿入するのではなく、Shiftドラッグにより、そのままデータ列を挿入する方が簡単です)。
ご回答いただきありがとございました。
『データ範囲を選択し、Ctrl+Gでジャンプダイアログを出して、「セル選択」「空白セル」で「OK」し、そのまま右クリックから「削除」から「上方向にシフト」を選択します。』
これが知りたかったポイントです。
大変参考になりました。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルについて教えてください。 3 2023/06/28 09:11
- Excel(エクセル) エクセルVBA VLOOKUPを使ってのカウント作業 2 2023/02/19 09:03
- Excel(エクセル) エクセルの数式で教えてください。 2 2023/01/12 09:24
- Excel(エクセル) エクセルの数式で教えてください。 1 2022/10/25 09:26
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/02/02 13:13
- Excel(エクセル) シート参照を含む数式を連続コピー 3 2022/12/10 11:42
- Excel(エクセル) 複数セルデータを別シートの単一セルにコピーしたい。(詳細をご参照ください) 1 2022/12/14 15:08
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 1 2023/02/02 09:25
- Excel(エクセル) Excel>マクロ>特定のセルで同じ情報が登録されている行を1行にまとめたい(文字連結) 6 2023/01/05 16:30
- Excel(エクセル) エクセルの数式で教えてください。 1 2023/02/02 10:20
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
関数TRANSPOSEで空白セルを0に...
-
数式による空白を無視して最終...
-
Excelで"0"を空白に変換する方法
-
Excel:関数が入っているセルに...
-
空白セル内の数式を残したまま...
-
Excel > ピボットテーブル「(空...
-
OpenOfficeでのワイルドカード...
-
Excel 特定セルの数値を参照し...
-
エクセルで、「複数のセルの中...
-
vlookup にて、返す値が、空白...
-
VLOOK関数で作った請求書で、¥...
-
リンクされているセルを空白と...
-
エクセルで上の行の値を自動的...
-
エクセルで、合計をもとめたい...
-
エクセルの数式で教えてください。
-
時間の差し引き 元セルが空白セル
-
【EXCEL】空白でないセルの位置...
-
Excel関数 直近3回分の出庫平均...
-
列の複数ある空白セルを飛ばし...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
IF関数で空欄("")の時、Null...
-
数式による空白を無視して最終...
-
エクセルでCSVを編集するとき、...
-
ピボットテーブルで空白セルの...
-
excel2010 空白セルにのみ貼り...
-
Excel > ピボットテーブル「(空...
-
空白セル内の数式を残したまま...
-
「データ要素を線で結ぶ」がチ...
-
エクセルで、「複数のセルの中...
-
Excelで、入力文字の後に自動で...
-
エクセル 連番が途切れていると...
-
《Excel2000》SUMPRODUCT関数で...
-
SUMIFS関数で「計算式による空...
-
【Excel】 csvの作成時、空白セ...
-
形式貼り付けの「空白を無視す...
-
Excel:関数が入っているセルに...
-
リンク先が空白若しくはゼロの...
-
エクセルで上の行の値を自動的...
-
エクセルにて負の時間を0:00と...
-
エクセルのグラフで式や文字列...
おすすめ情報