A 回答 (3件)
- 最新から表示
- 回答順に表示
No.3
- 回答日時:
解決されてましたらスルーしてください
以下のような考え方はどうでしょう
A列の空白セルを削除して
B列に & がある部分の抜き出し(行そのまま)
C列に & がない部分の抜き出し
C列先頭1つを削除して
空白行を削除して
A列を削除して
ループする記述がないので、ステップ実行で動きを見てください
なお、A列初めの内容に & があること、
※ 元々のデータ上でやるので注意してください
Public Sub Samp1()
Application.ScreenUpdating = False
With Range("A2", Cells(Rows.Count, "A").End(xlUp))
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
On Error GoTo 0
With .Offset(, 1)
.FormulaR1C1 = "=IF(COUNTIF(RC1,""*&*""),RC1,"""")"
.Value = .Value
End With
With .Offset(, 2)
.FormulaR1C1 = "=IF(RC[-1]="""",RC1,"""")"
.Value = .Value
.Cells(1).Delete xlShiftUp
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
.EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub
※ 上記は & のあるセルが連続しないことが前提です
連続することがあれば、以下のようになるかと
Public Sub Samp2()
Dim rng As Range
Application.ScreenUpdating = False
With Range("A2", Cells(Rows.Count, "A").End(xlUp))
On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
On Error GoTo 0
With .Offset(, 1)
.FormulaR1C1 = "=IF(COUNTIF(RC1,""*&*""),RC1,"""")"
.Value = .Value
Set rng = .SpecialCells(xlCellTypeBlanks).EntireRow
End With
With .Offset(, 2)
.FormulaR1C1 = "=IF(RC[-1]="""",RC1,"""")"
.Value = .Value
.Cells(1).Delete xlShiftUp
Intersect(rng _
, .SpecialCells(xlCellTypeBlanks).EntireRow).Delete
End With
.EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub
No.2
- 回答日時:
こんにちは。
マクロの典型的な練習問題のような題材ですね。
実行後では空白行は消えているということは、空白を削除する、というルールが加わっているようです。
'//
Sub AlignmentTest()
Dim Rng As Range
Dim c As Range
Dim stRng As Range
Dim lastRow As Long
Dim i As Long
Set Rng = Range("A2", Cells(Rows.Count, 1).End(xlUp))
Application.ScreenUpdating = False
For Each c In Rng
If c.Value Like "#&*" Then
Set stRng = c.Offset(, 1)
ElseIf c.Value <> "" Then
c.Copy stRng
c.ClearContents
Set stRng = c.Offset(, 1)
End If
Next c
'空いている行を埋める
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = lastRow To 2 Step -1
If Cells(i, 1).Value = "" And Cells(i, 2).Value = "" Then
Cells(i, 1).Resize(, 2).Delete '2列分削除
End If
Next i
Application.ScreenUpdating = True
End Sub
'///
No.1
- 回答日時:
こんにちは!
カット&ペーストではなく、Sheet2に表示するようにしてみました。
元データはSheet1にあるとします。
標準モジュールにしてみてください。
Sub Sample1()
Dim i As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:B").ClearContents
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If .Cells(i, "A") <> "" Then
If InStr(.Cells(i, "A"), "&") > 0 Then
wS.Cells(Rows.Count, "B").End(xlUp).Offset(1, -1) = .Cells(i, "A")
Else
wS.Cells(Rows.Count, "B").End(xlUp).Offset(1) = .Cells(i, "A")
End If
End If
Next i
End With
End Sub
こんな感じではどうでしょうか?m(_ _)m
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAで、特定の文字より後を削除して残った数値を文字列に変換と特定の文字より前も削除したい 3 2022/04/15 19:21
- Excel(エクセル) エクセルの条件付き書式で*を使いたい 4 2022/05/13 16:49
- Excel(エクセル) 関数EXACT(文字列,文字列)とexcelVBA 3 2022/04/14 15:07
- Excel(エクセル) エクセルで文字列と数字が混在する列に書式設定したい。 3 2022/12/19 09:11
- Visual Basic(VBA) EXCEL VBA 単語置き換え について質問です ブック名 ぶぶぶ シート名 ししし セル V3〜 3 2023/03/08 01:41
- Excel(エクセル) Excelのリストにある文字を含むセルを、複数の色で色付けしたいです 2 2022/08/11 17:39
- Excel(エクセル) Excel VBAで、行の高さを、上下1文字分程度高くしたい 3 2023/04/23 00:17
- その他(データベース) Accessのクエリで1フィールドの抽出条件設定をNullでなく全角半角含む空白のみの文字列でない文 1 2023/04/24 15:20
- C言語・C++・C# VisualStudioのソースコードで漢字を使いたい 4 2022/05/21 10:16
- Excel(エクセル) Excelのマクロで、特定のセルから順番に値を取得したい 5 2022/12/06 15:34
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【Excel関数】UNIQUE関数で"0"...
-
エクセルで特定の文字列が入っ...
-
エクセル 上下で列幅を変えるには
-
エクセルのマクロで意図しない...
-
アクティブになっている行をマ...
-
excelのデータで色つき行の抽出...
-
Excel 時刻の並び替え
-
Excel グラフのプロットからデ...
-
セルの色によって条件文をつけ...
-
VBAで色の付いているセルの行削除
-
Excelでカタカナ・ひらがな・英...
-
エクセル マクロ オートフィ...
-
Excel VBA アクティブセルから...
-
Excel2007で、指定範囲の行高さ...
-
[EXCEL]ボタン押す→時刻が表に...
-
サイズの違うセル 並べ変え
-
エクセルマクロ オートSUM(合...
-
特定の文字がある行以外を削除...
-
AのセルとB行を比較して、一致...
-
電話番号の入力方式が違うデー...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルで特定の文字列が入っ...
-
エクセル マクロ オートフィ...
-
【Excel関数】UNIQUE関数で"0"...
-
[EXCEL]ボタン押す→時刻が表に...
-
結合されたセルをプルダウンの...
-
エクセル マクロで数値が変っ...
-
Excel グラフのプロットからデ...
-
AのセルとB行を比較して、一致...
-
エクセル 上下で列幅を変えるには
-
Excel ウインドウ枠の固定をす...
-
特定の文字がある行以外を削除...
-
excelのデータで色つき行の抽出...
-
エクセル2016で時間を入力して...
-
excel 小さすぎて見えないセル...
-
EXCELで最後の行を固定
-
エクセルVBA 最終行を選んで並...
-
VBAで色の付いているセルの行削除
-
エクセルマクロで偶数行(又は...
-
エクセルのセルに指定画像(.jpg...
-
罫線の斜線を自動で引くマクロ
おすすめ情報