■Filter状態での可視セルから可視セルへのコピー

オートフィルタやフィルタオプションでデータ抽出し、ある列の表示部分（可視セル範囲）を別の列の可視セル範囲へコピーしたい、つまり横へそのままスライドした位置関係でコピーしたい場合があるとします。

通常の[コピー]-[貼り付け]操作では、非表示部分に貼り付けられたり、『そのコマンドは複数の選択範囲に対して実行できません』のエラーになったりします。

そこで、列の非表示を利用してFillRightやFillLeftメソッドを使うと良いです。
■AutoFilter FilterModeでのFillRightメソッドの応用になりますね。

まずサンプルシート作成。

Sub pre()
　　With Sheets.Add
　　　　With .Range("A1")
　　　　　　.Value = "f1"
　　　　　　.AutoFill .Resize(, 6)
　　　　End With
　　　　With .Range("B2:F10")
　　　　　　.Formula = "=int(rand()*10)"
　　　　　　.Value = .Value
　　　　End With
　　　　.Range("4:4,7:7").ClearContents
　　　　.Range("A4,A7,A11").Value = 1
　　　　.Range("D4,D7").FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
　　　　.Range("D11").FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
　　　　.Range("A1").CurrentRegion.AutoFilter 1, 1
　　　　.Range("D2:D11").Interior.Color = vbYellow
　　　　.ShowAllData
　　End With
End Sub

Sub pre()実行後。


A列の値が 1 で抽出した後のD列をF列にコピーします。（色付けしたセル）

Sub test1()
　　With ActiveSheet
　　　　.Range("A1").CurrentRegion.AutoFilter 1, 1
　　　　.Columns("E").Hidden = True
　　　　.Range("D2:F11").FillRight
　　　　.Columns("E").Hidden = False
　　　　.ShowAllData
　　End With
End Sub

同じく、D列をB列にコピーします。

Sub test2()
　　With ActiveSheet
　　　　.Range("A1").CurrentRegion.AutoFilter 1, 1
　　　　.Columns("C").Hidden = True
　　　　.Range("B2:D11").FillLeft
　　　　.Columns("C").Hidden = False
　　　　.ShowAllData
　　End With
End Sub

実行後。


こんな感じで、非表示セルに影響与えず、可視セル間のコピーができます。

ぁ、別にマクロでなく、手作業で可能です。
フィルタ抽出状態で、対象外の列を非表示にして、コピー元とコピー先を隣接させて選択します。
その後[編集]-[フィル]-[右方向へコピー]です。ショートカットキーは[Ctrl]+[r]。
左列へコピー、.FillLeftメソッドは[編集]-[フィル]-[左方向へコピー]です。

または、コピー元とコピー先を隣接させた後、コピー元だけ選択してフィルハンドルを右あるいは左へドラッグ。...という操作でも同じ結果になります。

■条件付書式。数式はR1C1形式で。（検証編）

昨日の記事が少しぶっきらぼうだったので、補足。
それにmoug.netのログが消えたら意味がわからないでしょうし。

結論から簡単に書くと、
『VBAで条件付書式を設定する時、その条件がセルアドレスを参照する数式条件の場合は、コード実行時のActiveCellの位置によって数式条件のセルアドレスが相対的に変化してしまう。
∴条件付書式を設定する範囲の基点セルをSelectして実行するか、数式をR1C1形式で記述する。
（R1C1形式で設定する場合はSelect不要）』
という事です。

まずテストコード全掲載。

Option Explicit
Const KITEN = "B2" 'テスト範囲基点のアドレス
'---------------------------------------------------------------------
Sub pre()
　　Dim r As Range
　　Dim f As Boolean

　　f = True
　　With Sheets(1)
　　　　For Each r In .Range(KITEN).Resize(5, 5)
　　　　　　If f Then r.Value = 1
　　　　　　f = Not f
　　　　Next
　　End With
End Sub
'---------------------------------------------------------------------
Sub test1()
　　Dim r As Range

　　With Sheets(1)
　　　　Set r = .Range(KITEN)
　　　　r.Offset(1).Select
　　　　With r.Resize(5, 5).FormatConditions
　　　　　　.Delete
　　　　　　.Add(Type:=xlExpression, Formula1:="=" & KITEN & "=1" _
　　　　　　　　).Interior.ColorIndex = 6
　　　　End With
　　End With
　　Debug.Print "test1_1", r.FormatConditions(1).Formula1
　　r.Select
　　Debug.Print "test1_2", r.FormatConditions(1).Formula1

　　Set r = Nothing
End Sub
'---------------------------------------------------------------------
Sub test2()
　　Dim r As Range

　　With Sheets(1)
　　　　Set r = .Range(KITEN)
　　　　r.Offset(1).Select
　　　　With r.Resize(5, 5).FormatConditions
　　　　　　.Delete
　　　　　　.Add(Type:=xlExpression, Formula1:="=RC=1" _
　　　　　　　　).Interior.ColorIndex = 6
　　　　End With
　　End With
　　Debug.Print "test2_1", r.FormatConditions(1).Formula1
　　r.Select
　　Debug.Print "test2_2", r.FormatConditions(1).Formula1

　　Set r = Nothing
End Sub
'---------------------------------------------------------------------
Sub test3()
　　Dim r　 As Range
　　Dim ref As Long

　　With Application
　　　　ref = .ReferenceStyle
　　　　.ReferenceStyle = xlR1C1
　　End With
　　With Sheets(1)
　　　　Set r = .Range(KITEN)
　　　　r.Offset(1).Select
　　　　With r.Resize(5, 5).FormatConditions
　　　　　　.Delete
　　　　　　.Add(Type:=xlExpression, Formula1:="=RC=1" _
　　　　　　　　).Interior.ColorIndex = 6
　　　　End With
　　End With
　　Debug.Print "test3_1", r.FormatConditions(1).Formula1
　　r.Select
　　Debug.Print "test3_2", r.FormatConditions(1).Formula1
　　Application.ReferenceStyle = ref

　　Set r = Nothing
End Sub

Sub pre()実行後。


基点セルから5x5の範囲に条件付書式を設定します。
Sub test1()実行後。


本当は『=自アドレス=1』の数式条件を満たすセルに色づけしたいのですが、
r.Offset(1).Select
しているために、基点セルB2の数式条件がずれてしまいます。


（Offsetせず、基点rをSelectすればずれません）

Selectしたくない、もしくはSheetをActiveにしたくない場合、数式をR1C1形式にします。
Sub test2()実行後。


ActiveCellの位置関係なく、数式条件が正しく設定されます。

---

ついでに。
条件付書式で設定された条件内の数式を取得したい場合もActiveCellとの相対位置によって数式が変化します。
これは数式をR1C1形式で記述したtest2でも同様です。

Debug.Print "test2_1", r.FormatConditions(1).Formula1
r.Select
Debug.Print "test2_2", r.FormatConditions(1).Formula1

この部分。結果は

test2_1　　　 =B3=1
test2_2　　　 =B2=1

同じ r の条件が変化しています。
これを、ActiveCell位置に関係なく取得したい場合は、Applicationのアドレス参照形式をR1C1形式に変更します。
Sub test3()での

With Application
　　ref = .ReferenceStyle
　　.ReferenceStyle = xlR1C1
End With

この部分。（後で戻しています）

test1からtest3まで実行したイミディエイトウィンドウの結果は
【2003の場合】

test1_1　　　 =B2=1
test1_2　　　 =B1=1
test2_1　　　 =B3=1
test2_2　　　 =B2=1
test3_1　　　 =RC=1
test3_2　　　 =RC=1

こうなります。

ちなみに、
【2007の場合】

test1_1　　　 =B1=1
test1_2　　　 =B1=1
test2_1　　　 =B2=1
test2_2　　　 =B2=1
test3_1　　　 =B2=1
test3_2　　　 =B2=1

2007では条件取得時のアドレスの変化については改善されているようです。

こういった事象に対する質疑って、Q&A掲示板ではあまり見かけませんが、VBAで条件付書式を設定する時のセオリーのようですね。
『Excelノート　6-1　書式　14　マクロで条件付書式（数式）を設定するには？』
http://park11.wakwak.com/~miko/Excel_Note/06-01_shoshiki.htm#06-01-14

さらに深い過去ログ
『条件付書式の数式の評価について』
http://www.keep-on.com/excelyou/1999lng4/199909/99090110.txt
『条件付書式による色をVBAから取得するには？』
http://www.keep-on.com/excelyou/2000lng4/200005/00050350.txt

#こういった情報があると、やっぱり過去ログって先人の経験と知恵が詰まったおタカラだよなぁって思います。
#それを探り当てる検索エンジンも凄いっ...てのも言えるかもしれませんけどね :D

■条件付書式。数式はR1C1形式で。

ん。
勘違いが間違いだったか...X(

『条件付書式設定のマクロ化コード』
http://moug.net/faq/viewtopic.php?t=47140
ActiveCell位置によっては条件付書式の数式のアドレスが思った通りにならないという話ですが、
仮にリンクスレッドに書かれた条件がB2セル基点だったとしても、

Sub try()
　　With Sheets(1).Range("B2:C18").FormatConditions
　　　　.Delete
　　　　.Add Type:=xlExpression, _
　　　　　　 Formula1:="=ASC(RC2&RC3)<>""00"""
　　　　.Item(1).Interior.ColorIndex = 6
　　End With
End Sub

R1C1形式の数式を使うと、指定した範囲の１セル目を基点にした数式で設定できます。
なのでSelectは必要なかったンでした。

#でも2007では落とし穴の話があったようななかったような...
#気が向いたら検証しよっと

■WebQueryの失敗（その後の後

#また懺悔ネタなのである...

■WebQueryの失敗
■WebQueryの失敗（その後
２回に渡ってIE7でのWebQuery連続実行の不具合を取り上げてますが、どうやら誤爆らしい。ごめんなさい ;(
正しくは『//quote.yahoo.co.jpに対するIE7でのWebQuery連続実行には不具合がある』ということになるのかしらん。
巷で言われているように、キャッシュがいっぱいになる事が原因であったり、『Excelで株投資>ファイナンス取得不安定』ここに転載されているMicrosoftの見解、『セキュリティ設定により外部パラメータの使用に制限が加えられたことに起因する現象』が原因だったりするなら、他のサイトでも同様の現象になってもおかしくはない。

Excel2003/IE7の環境での簡単な検証コード。
（新規Bookの標準モジュールでの実行を推奨。新規シート追加の上テストします）

Option Explicit

Sub test()
　　Dim sURL(2) As String

　　On Error GoTo errHndlr
　　'yahooファイナンス
　　sURL(0) = "URL;http://quote.yahoo.co.jp/q?s="
　　sURL(2) = ""
　　Call try(Sheets.Add, sURL)
　　'Infoseekマネー
　　sURL(0) = "URL;http://money.www.infoseek.co.jp/MnStock/"
　　sURL(2) = "/sresult.html"
　　Call try(Sheets.Add, sURL)
　　'msnマネー
　　sURL(0) = "URL;http://jp.moneycentral.msn.com/investor/" _
　　　　　　& "quotes/quotes.aspx?symbol=JP:"
　　sURL(2) = ""
　　Call try(Sheets.Add, sURL)

　　Exit Sub
errHndlr:
　　Debug.Print Err.Number, Err.Description
　　Resume Next
End Sub
'---------------------------------------------------------------------
Sub try(ByRef ws As Worksheet, ByRef sURL() As String)
　　Dim i As Long

　　With ws.QueryTables.Add(Connection:=sURL(0), _
　　　　　　　　　　　　　　Destination:=ws.Range("A1"))
　　　　.RefreshStyle = xlOverwriteCells
　　　　.AdjustColumnWidth = False
　　　　.WebSelectionType = xlAllTables
　　　　.WebFormatting = xlWebFormattingNone
　　　　For i = 3001 To 3100　　'適当
　　　　　　sURL(1) = i
　　　　　　.Connection = Join(sURL, "")
　　　　　　.Refresh BackgroundQuery:=False
　　　　Next
　　End With
End Sub

結果は、//quote.yahoo.co.jpに対するWebQueryのみエラーになります。
//quote.yahoo.co.jpについては、ソースコードが原因でExcel2000のWebQueryで取り込みできなくなった経緯もありますし、複数の要因が絡んでの現象なのかもしれません。

（何回も書いてますが:D）自分では株取引ってやらないし、必要であればServerXMLHTTPを使えばいい事なので全然困らないのですが、これからはQ&Aサイトで検証もせずに『IE7でのWebQuery連続実行には不具合ありますヨ』..なんて書くことがないようにしよっ。反省orz

■xl2003：QueryTables.Deleteと.Names().Delete

はぁ...また懺悔になってしまうのでしょうか。
最近、メイン環境が[win2000/xl2000]から[winXP/xl2003]に変わってしまった事もあって気づいたんですが、
結論から言うとxl2003sp3ではQueryTables.Deleteすると[名前定義]も削除されます。
■QueryTables.Add/.Deleteと.Names().Deleteの記事アップ当時、xl2003も社内にあったので検証したような記憶があるんですけどね。（その時sp3だったかどうかまでは憶えてません）
また嘘つきになっちゃうのかぁと落ち込んだのですが、たまたまspがあたってない2003があって、そちらで実行すると依然、名前定義が残ります。当時はsp3ではなかったのでしょう、多分。
どのUpdateで変更されたのかわかりませんが、少なくとも2003のsp3では改善されているようです。
（ちなみに2000sp3は変わらず）
VBEのマウスホイールの件や、このQueryTableのName問題など、sp3で色々と改善されたのは良いンですけど、何が改善されたかもうちょっと情報が欲しいところです...よねぇ。
ここからOffice2003_SP3Changes.xls落として見たけど見つけられなかった...英語だし。

一応、確認用コード。

Option Explicit

Sub test2003sp3()
　　Dim s As String
　　Dim i As Long

　　s = "http://blog.goo.ne.jp/end-u"
　　With Sheets.Add
　　　　For i = 1 To 5
　　　　　　.UsedRange.ClearContents
　　　　　　With .QueryTables.Add(Connection:="URL;" & s, _
　　　　　　　　　　　　　　　　　Destination:=.Range("A1"))
　　　　　　　　.RefreshStyle = xlOverwriteCells
　　　　　　　　.AdjustColumnWidth = False
　　　　　　　　.WebFormatting = xlWebFormattingNone
　　　　　　　　.Refresh BackgroundQuery:=False
　　　　　　　　Debug.Print .Name
　　　　　　　　.Delete
　　　　　　End With
　　　　Next
　　　　MsgBox "Query:= " & .QueryTables.Count & vbLf & _
　　　　　　　 "Name:= " & .Names.Count
　　End With
End Sub

（2009.09.14追記）
#Office2003_SP3Changes.xls というのは上記リンク先
#http://support.microsoft.com/kb/923618/ja
#からダウンロードできる『Office 2003 SP3 で修正される Office 2003 Service Pack 2 以降の問題の一覧が掲載された Microsoft Excel ブック』の事です。（英語版のみ）