締切済み

VBA 毎回データが違っても応用できるコード

  • 困ってます
  • 質問No.9539233
  • 閲覧数156
  • ありがとう数3
  • 気になる数0
  • 回答数3
  • コメント数0

お礼率 56% (176/312)

O列をフィルタで昇順にして、2以上の数値(#N/Aも含む)をコピーして同じ行のQ列に値でペーストするといった流れです。
下記のコードはマクロで記録で作成したものです。

Range("O632:O705").Select
O632から最後尾のO705までのセルをコピー
 Range("Q632").Select
同じ行のQ632セルを選択し、値でペーストする。

データは毎回バラバラなので
(O400~O800だったり)、応用できるコードを教えて頂けないでしょうか?
宜しくお願いします。

    ActiveWorkbook.Worksheets("シート1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("シート1").AutoFilter.Sort.SortFields.Add Key:= _
        Range("O1:O705"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("シート1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Range("O632:O705").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-48
    Range("Q632").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=56
End Sub

回答 (全3件)

  • 回答No.3

ベストアンサー率 45% (131/287)

最初の行の判定は情報不足で解りません。

>O632から最後尾のO705までの
O631までが空白なら
s = Range("O1").End(xlDown).Row 'データの最初
e = Range("O" & s).End(xlDown).Row 'データの最後
Range("O" & s & ": O" & e).Select
で選択できます。
補足コメント
nkmyr

お礼率 56% (176/312)

ありがとうございます。

すみません、手順が違っていましたので、修正しました。
O列をフィルタで昇順にします。
2以上の数値(#N/Aも含む)が入った行のP列をコピーして同じ行のQ列に値でペーストするといった流れです。
見やすくするため、ペーストしたものは赤い文字にしてくれたらありがたいです。
宜しくお願いします。

O列   P列 Q列
2 79 79
2 79 79
3 #N/A #N/A
4 #N/A #N/A
5 80 80
8 80 80
8 80 80
10 80 80
11 80 80
18 #N/A #N/A
#N/A 84 84
#N/A 80 80
↑   ↑
コピー  値でペースト
投稿日時 - 2018-09-21 10:19:27
お礼コメント
nkmyr

お礼率 56% (176/312)

すみません。
締め切って再度質問しますので、宜しくお願いします。
投稿日時 - 2018-09-21 10:22:05
  • 回答No.2

ベストアンサー率 59% (174/291)

Visual Basic カテゴリマスター
やりたいことが
>2以上の数値(#N/Aも含む)をコピーし、
>同じ行のQ列に値でペーストする
ことで、

その手段として
>O列をフィルタで昇順にして
その後必要な範囲をコピー&ペーストしているということでしょうか。

つまり、単に
O列を2行目から下方向に調べ
>2以上の数値(#N/Aも含む)
があったら、
それを同じ行のQ列に値を複写すればいいんですね?

ならば、関数でもできそうですが
VBAであれば、

Sub Sample()
 
 Dim RowCounter As Long
 
 With ThisWorkbook.Sheets(1)
  
  .Columns(17).ClearContents
  RowCounter = 2
  
  Do
   
   If IsError(.Cells(RowCounter, 15).Value) = False Then
    If .Cells(RowCounter, 15).Value = "" Then
     Exit Do
    End If
   End If
   
   If IsError(.Cells(RowCounter, 15).Value) = True Then
    .Cells(RowCounter, 17).Value = _
    .Cells(RowCounter, 15).Value
   ElseIf .Cells(RowCounter, 15).Value >= 2 Then _
    .Cells(RowCounter, 17).Value = _
    .Cells(RowCounter, 15).Value
   End If
  
   RowCounter = RowCounter + 1
  
  Loop
 
 End With

End Sub


でいかがでしょうか。
補足コメント
nkmyr

お礼率 56% (176/312)

ありがとうございます。

すみません、手順が違っていましたので、修正しました。
O列をフィルタで昇順にします。
2以上の数値(#N/Aも含む)が入った行のP列をコピーして同じ行のQ列に値でペーストするといった流れです。
見やすくするため、ペーストしたものは赤い文字にしてくれたらありがたいです。
宜しくお願いします。

O列   P列 Q列
2 79 79
2 79 79
3 #N/A #N/A
4 #N/A #N/A
5 80 80
8 80 80
8 80 80
10 80 80
11 80 80
18 #N/A #N/A
#N/A 84 84
#N/A 80 80
↑   ↑
コピー  値でペースト
投稿日時 - 2018-09-21 10:18:37
お礼コメント
nkmyr

お礼率 56% (176/312)

すみません。
締め切って再度質問しますので、宜しくお願いします。
投稿日時 - 2018-09-21 10:22:26
  • 回答No.1

ベストアンサー率 62% (434/692)

Visual Basic カテゴリマスター
>2以上の数値(#N/Aも含む)をコピーして同じ行のQ列に値でペーストする
最初にO列の最終行を検出します。
Dim LR As Long, i As Long
LR = Cells(Rows.Count, "O").End(xlUp).Row
次に
> Range("O1:O705"), SortOn:=xlSortOnValues, Order:=xlAscending,
    ↓
Range("O1:O" & LR), SortOn:=xlSortOnValues, Order:=xlAscending,
次は
>Range("O632:O705").Select
>Selection.Copy
>ActiveWindow.SmallScroll Down:=-48
>Range("Q632").Select
>Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
> :=False, Transpose:=False
> ActiveWindow.SmallScroll Down:=56
> End Sub
    ↓
  For i = 1 To LR
    If Cells(i, "O").Value >= 2 Then Exit For
  Next
  Range(Cells(i, "O"), Cells(LR, "O")).Copy
  Cells(i, "Q").PasteSpecial Paste:=xlPasteValues
  Application.CutCopyMode = False
End Sub
補足コメント
nkmyr

お礼率 56% (176/312)

ありがとうございます。

すみません、手順が違っていましたので、修正しました。
O列をフィルタで昇順にします。
2以上の数値(#N/Aも含む)が入った行のP列をコピーして同じ行のQ列に値でペーストするといった流れです。
見やすくするため、ペーストしたものは赤い文字にしてくれたらありがたいです。
宜しくお願いします。

O列   P列 Q列
2 79 79
2 79 79
3 #N/A #N/A
4 #N/A #N/A
5 80 80
8 80 80
8 80 80
10 80 80
11 80 80
18 #N/A #N/A
#N/A 84 84
#N/A 80 80
↑   ↑
コピー  値でペースト
投稿日時 - 2018-09-21 10:19:07
お礼コメント
nkmyr

お礼率 56% (176/312)

すみません。
締め切って再度質問しますので、宜しくお願いします。
投稿日時 - 2018-09-21 10:21:49
AIエージェント「あい」

こんにちは。AIエージェントの「あい」です。
あなたの悩みに、OKWAVE 3,500万件のQ&Aを分析して最適な回答をご提案します。

関連するQ&A
こんな書き方もあるよ!この情報は知ってる?あなたの知識を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する

特集

ピックアップ

ページ先頭へ