Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


74924 / 76732 ←次へ | 前へ→

【6260】Re:範囲の取得
回答  ゆと E-MAIL  - 03/6/20(金) 19:50 -

引用なし
パスワード
   キタ さん,ぴかるさんこんばんは。
とりあえず、力不足かもしれませんが、なんとなくコードを書いてみました。
仮定に仮定を重ねた怪しげなものですが。

Sub Sample()
  Dim AACD&, BBCD&, NewRecCnt&
  Dim i&, ARecCnt&, BRecCnt&, TempRecCnt&
  'AACD、BBCDをきちんと設定しないと動きません。仮定で A列、B列をしておきます。
  AACD& = 1: BBCD = 2
  'シートCが空白だと仮定
  NewRecCnt& = 2
  
  Application.ScreenUpdating = False
  'A列最終行までデータが入っていると仮定
  ARecCnt& = Sheets("A").Cells(65536, 1).End(xlUp).Row
  BRecCnt& = Sheets("B").Cells(65536, 1).End(xlUp).Row
  
  '1行目はタイトル行と仮定。
  Sheets("A").Rows(1).Copy Destination:=Sheets("C").Rows(1)  'シートCにタイトル行を追加
  For i& = 2 To ARecCnt&
    With Sheets("A")
      If .Cells(i&, AACD).Value = 1 And .Cells(i&, BBCD).Value = 2 Then
        .Rows(i&).Copy Destination:=Sheets("C").Rows(NewRecCnt&)
        NewRecCnt = NewRecCnt + 1
      End If
    End With
  Next i&
  TempRecCnt = NewRecCnt
  On Error Resume Next  'ソートに関する細かい設定は 『Sort』でHELPをご参照ください。
    Sheets("C").Rows("2:" & TempRecCnt& - 1).Sort Key1:=Range("K2")
  On Error GoTo 0
  For i& = 2 To BRecCnt&
    With Sheets("B")
      If .Cells(i&, AACD).Value = 1 And .Cells(i&, BBCD).Value = 2 Then
        .Rows(i&).Copy Destination:=Sheets("C").Rows(NewRecCnt&)
        NewRecCnt& = NewRecCnt& + 1
      End If
    End With
  Next i&
  On Error Resume Next
    Sheets("C").Rows(TempRecCnt& & ":" & NewRecCnt& - 1).Sort Key1:=Range("K" & TempRecCnt&)
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub
2 hits

【6227】範囲の取得 キタ 03/6/19(木) 16:47 質問
【6230】Re:範囲の取得 ぴかる 03/6/19(木) 17:42 回答
【6252】Re:範囲の取得 キタ 03/6/20(金) 16:41 質問
【6253】Re:範囲の取得 ぴかる 03/6/20(金) 16:52 発言
【6255】Re:範囲の取得 キタ 03/6/20(金) 17:36 発言
【6260】Re:範囲の取得 ゆと 03/6/20(金) 19:50 回答
【6348】Re:範囲の取得 キタ 03/6/25(水) 16:04 お礼

74924 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free