Excel VBA質問箱 IV

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

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


38047 / 76732 ←次へ | 前へ→

【43828】Re:別シートのデータを条件別に取得
質問  モナ  - 06/10/26(木) 13:48 -

引用なし
パスワード
   以下のマクロで動かしています。
素人記述です。
なんとか、無駄を省いたスマートな記述にできればと思います。
【43794】で書いてくださったソースに
うまくきれいにはめてすっきりさせていただけないでしょうか?
それを元に勉強したいと思います。


1.マクロ11

Sub test1()
  Set WS1 = Worksheets("元")
  Set WS2 = Worksheets("OK")
  Set WS3 = Worksheets("OK2")
  Dim Rtn As Integer
  
  
  Workbooks.Open Filename:="甲.xls"
  
  With Worksheets("甲").Range("A1") '★ここのWithを整理したい。
    .Range("A1:B4").Copy Destination:=WS2.Range("A1")
    .Range("A1:B4").Copy Destination:=WS3.Range("A1")
  End With
    
  With Worksheets("joblog").Range("G6")
    .AutoFilter Field:=7, Criteria1:="ftime"
    .CurrentRegion.SpecialCells(xlVisible).Copy WS2.Range("A6")
    
    .AutoFilter Field:=7, Criteria1:="ntime"
    .CurrentRegion.SpecialCells(xlVisible).Copy WS3.Range("A6")
    
    .AutoFilter Field:=7, Criteria1:="<>ftime", Operator:=xlAnd, _
    Criteria2:="<>ntime"
    .CurrentRegion.SpecialCells(xlVisible).Copy WS1.Range("A1")
    
    .AutoFilter
  End With
  Workbooks("甲.xls").Close
  
   ’★ここで、「甲.xlsは変更されています。保存しますか?」のMsgボックスが出てくるが、自動的にNo(保存しない)を選択して閉じたい
  
  WS1.Activate
End Sub


2.マクロ12(1-2-1と1-2-2をくっつけました)
Sub FromTo作成()
  Set WS1 = Worksheets("元")
  Set WS4 = Worksheets("抽出")
  Set WS4 = Worksheets("エラー")

  Dim FT As String
  
  With WS1.Range("A1")
  FT = (WS1.Range("N2").Value = WS1.Range("P2").Value)

  If FT = "False" Then
    .Range("N1:N65536").Copy Destination:=WS2.Range("A1")
    .Range("P1:P65536").Copy Destination:=WS2.Range("B1")
    .Range("D1:D65536").Copy Destination:=WS2.Range("F1")
    .Range("X1:X65536").Copy Destination:=WS2.Range("G1")
    
  Else
    .Range("N1:N65536").Copy Destination:=WS2.Range("A1")
    .Range("O1:O65536").Copy Destination:=WS2.Range("B1")
    .Range("Q1:Q65536").Copy Destination:=WS2.Range("C1")
    .Range("D1:D65536").Copy Destination:=WS2.Range("F1")
    .Range("X1:X65536").Copy Destination:=WS2.Range("G1")
  End If
  End With
  
  WS4.Activate
  
End Sub
2 hits

【43790】別シートのデータを条件別に取得 モナ 06/10/25(水) 21:04 質問
【43794】Re:別シートのデータを条件別に取得 maverick 06/10/25(水) 23:50 回答
【43799】Re:別シートのデータを条件別に取得 モナ 06/10/26(木) 8:47 質問
【43823】Re:別シートのデータを条件別に取得 maverick 06/10/26(木) 12:07 発言
【43828】Re:別シートのデータを条件別に取得 モナ 06/10/26(木) 13:48 質問
【43841】Re:別シートのデータを条件別に取得 maverick 06/10/26(木) 18:27 発言
【43844】Re:別シートのデータを条件別に取得 モナ 06/10/26(木) 18:59 発言
【43874】Re:別シートのデータを条件別に取得 maverick 06/10/27(金) 11:58 発言
【43895】Re:別シートのデータを条件別に取得 モナ 06/10/28(土) 18:00 発言

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