Results of 1 - 1 of about 71 for ExecuteExcel4Macro 閉じた｜開いて｜開かず (0.012 sec.)
executeexcel4macro (140), 閉じた (629), 開いて (4904), 開かず (263)
- [[20160305005942]]
- #score: 14119
- @digest: 5a57f79ccc3e245412ae6e05839fdf5e
- @id: 70084
- @mdate: 2016-04-04T13:52:19Z
- @size: 19036
- @type: text/plain
- #keywords: appexcel (178998), divrgb (43608), findformat (37963), パレ (14307), getobject (13613), xlformulas (12707), xlbyrows (8911), book2 (8716), 89 (8682), searchformat (8589), matchbyte (8031), 色番 (7371), searchdirection (6921), shf (6687), interior (6190), rgb (5644), searchorder (5485), xlprevious (5398), パン (5003), レッ (4696), 自宅 (4454), matchcase (3756), color (3564), 2016 (3208), 成功 (2857), 会社 (2696), xlsx (2490), entirerow (2336), 色付 (2306), 削除 (2147), 土) (2128), workbooks (2066)
- 『Book2の同じ色の行を消して、その最後の2行をBook1に貼り付ける』（パン）
Book2の、同じ色がランダムに付いた行を消してから最終行の2行の一部をコピーして、 あらかじめ開いておいたBook1に貼り付ける、というのをしたいのですが、 真ん中あたりの「r.Select」で「オブジェクト変数または with ブロック変数が設定されていません。」エラーが出て先に進みません。 どう対処すればいいか教えてください。m(_ _)m http://www.excel.studio-kazu.jp/kw/20091117104756.html ←参考 Dim appExcel As Object Dim i As Long Dim s As Long Dim r As Range Set appExcel = GetObject("C:¥temp¥Book2.xlsx") i = appExcel.Worksheets(1).UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row Application.FindFormat.Interior.Color = RGB(255, 0, 0) With ActiveSheet.Range("$A$1:$U$500") Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _ MatchByte:=False, SearchFormat:=True) r.Select While Not r Is Nothing r.EntireRow.Delete Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _ MatchByte:=False, SearchFormat:=True) Wend End With For s = 11 To 17 Cells(2, s - 7) = ExecuteExcel4Macro("'C:¥temp¥Book2.xlsx]Sheet1'!R" & i & "C" & s & "") Next s For s = 11 To 17 Cells(1, s - 7) = ExecuteExcel4Macro("'C:¥temp¥Book2.xlsx]Sheet1'!R" & i - 1 & "C" & s & "") Next s End Sub ＜ 使用 Excel:Excel2010、使用 OS:Windows8 ＞ ---- コードはよく読んでいないのですが、一般論として。 Findメソッド、これは、シート上の検索操作そのものなんですが、シート上でも検索対象がなければ 【ありません】というメッセージがでますね。 コード実行でも同じことで、見つかれば r には、そのセルの Rangeオブジェクトが入りますが、 見つからなかった場合は、'Nothing' が返されます。 で、r が Nothing ですから r.Select とやろうとすると、エクセルが、どこを選択していいのかわからず こんな領域はないぞ!!! と叱るわけです。 そもそも、このコードでは r.Select って必要ないでしょ? どこでも、Selection を参照していませんので。 ところで、インデントを全くつけない、このコード、自分でも見づらくないですか? （β） 2016/03/05(土) 04:48 ---- テーマとは関係ありませんが気になったので。 Book2.xlsx の最初のシートのシート名は "Sheet1" になっているんだと思われますが appExcel.Worksheets(1) を参照して、その使用領域の最大行番号を取得していますね。 で、後半の値転記は "Sheet1" という名前を特定して参照しています。 もし、最初のシートが "Sheet1" ではなかったら、おかしなことになります。 また、最初のシートは "Sheet1" だから大丈夫だということなら、appExcel.Worksheets(1) も appExcel.Worksheets("Sheet1") と記述するほうがわかりやすいですね。 （というか、そのように記述すれば、万が一シートの順番がいれかわって保存されていたとしても不具合は回避できますから） また、ちゃんと認識して、使っておられるのでしょうが、Set appExcel = GetObject("C:¥temp¥Book2.xlsx") これは、非表示ブックにはなりますが 実際にエクセル区画で開かれています。（普通のコードでは Workbooks.Open を実行するところでしょうし、それと表示・非表示をのぞけばかわりありません） 何を言いたいかというと、この Book2.xlsxの"Sheet1"からマクロブックのアクティブシートに値を取り込むためにわざわざ【不自由な】ExecuteExcel4Macro を使う必要は 全くなく、【普通の】転記コードが使えます。しかも、転記のためにループさせる必要はさらさらなく、コピペであっても、転記先.Value = 転記元.Value であってもいいですが 1行で転記ができますよ。 （β） 2016/03/05(土) 08:50 ---- たぶん、こういうことなんじゃないかと推測で。 Sub Test() Dim appExcel As Object Dim i As Long Dim r As Range Set appExcel = GetObject("C:¥temp¥Book2.xlsx") i = appExcel.Sheets("Sheet1").UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row Application.FindFormat.Interior.Color = vbRed With ActiveSheet.Range("$A$1:$U$500") Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _ MatchByte:=False, SearchFormat:=True) While Not r Is Nothing r.EntireRow.Delete Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _ MatchByte:=False, SearchFormat:=True) Wend End With Range("D2:J2").Value = appExcel.Sheets("Sheet1").Range("K" & i).Resize(, 7).Value Range("D1:J1").Value = appExcel.Sheets("Sheet1").Range("K" & i - 1).Resize(, 7).Value appExcel.Close False 'あとあと悪さをしないよう念のため Set appExcel = Nothing '同上 End Sub （β） 2016/03/05(土) 13:27 ---- ↑ あっ! コードでは色付きセルの行削除はアクティブブックのシートに対する処理だったので それに合わせたコード案をアップしましたが、質問文では、 >>Book2の、同じ色がランダムに付いた行を消してから最終行の2行の一部をコピーして とありますから、行削除すべきは Set appExcel = GetObject("C:¥temp¥Book2.xlsx") で持ってきた Book2だったんですね? 不思議だなぁと思うのは、もし、r.Select によるエラーが発生しないようなシートだった場合処理はされるわけですけど その時、おかしいなとは思われなかったのですか? それとも、そちらでは、Book2の色付き行が削除されているのですか? （β） 2016/03/05(土) 15:02 ---- ↑でコメントしたような要件だったとしたら。 Sub Test2() Dim appExcel As Object Dim i As Long Dim r As Range Dim shF As Worksheet Dim shT As Worksheet Set appExcel = GetObject("C:¥temp¥Book2.xlsx") Set shF = appExcel.Sheets("Sheet1") Set shT = Workbooks("Book1.xlsx").Sheets("Sheet1") '★ ここは実際のものに Application.FindFormat.Interior.Color = vbRed With shF.Range("$A$1:$U$500") Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _ MatchByte:=False, SearchFormat:=True) While Not r Is Nothing r.EntireRow.Delete Set r = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _ MatchByte:=False, SearchFormat:=True) Wend End With i = shF.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row shT.Range("D2:J2").Value = shF.Range("K" & i).Resize(, 7).Value shT.Range("D1:J1").Value = shF.Range("K" & i - 1).Resize(, 7).Value appExcel.Close False 'あとあと悪さをしないよう念のため Set appExcel = Nothing '同上 End Sub （β） 2016/03/05(土) 15:14 ---- 最初から書き直すとしたら Sub test() Dim ws As Worksheet Dim wb As Workbook Dim i As Long Dim c As Range, r As Range Dim n As Long Set ws = ActiveSheet '★転記先シート Application.ScreenUpdating = False Set wb = Workbooks.Open("C:¥temp¥Book2.xlsx") With wb.Sheets("Sheet1").Range("A1:U" & Range("A" & Rows.Count).End(xlUp).Row) Application.FindFormat.Clear Application.FindFormat.Interior.Color = vbRed For i = .Rows.Count To 1 Step -1 Set c = .Rows(i).Find(What:="", SearchFormat:=True) If c Is Nothing Then n = n + 1 If n = 1 Then Set r = .Rows(i) Else Set r = Union(r, .Rows(i)) End If If n = 2 Then Exit For End If Next End With If Not r Is Nothing Then r.Columns("K:Q").Copy ws.Range("D1").PasteSpecial xlPasteValues Application.CutCopyMode = False End If Application.FindFormat.Clear wb.Close False End Sub （マナ） 2016/03/05(土) 19:38 ---- 失礼します。 To マナさん おそらく・・・・・まず、Book2シートで赤色セル行があれば削除し、 その上で（削除された後の）シートイメージを取り込むのではと・・・ （β） 2016/03/05(土) 20:26 ---- なるほどです。 行削除したあとの集計結果?などを転記したいという感じですか。 転記だけなら削除しなくてもと考えましたが、浅はかでした。 （マナ） 2016/03/05(土) 20:43 ---- βさん、説明が悪いのに読み取って下さったりとか、色々とすみません。 βさんの「2016/03/05(土) 15:14」ので、思う通りにできました。 ありがとうございました。m(_ _)m マナさんもありがとうございました。m(_ _)m 後出しですが、Book2のSheet1のセルには○、×、-などの選択肢があり、 一覧の一番下にその項目ごとの合計があって、 さらに一覧には該当しないものに色がつけてあったので、 参考のURLを元にした結果、r.Selectの問題にぶつかってしまったわけです。 もちろん、r.Selectでエラーになるため、色付きの行は削除されません。 また、該当しない行を削除すると、合計行の行番号が変わってしまうため、 「最後の行」のマクロを使用していました。 今まで、必要だと思ったコードをネットで探してコピペしていたので、 訳も分からずマクロを組んでいました。 これを機会に勉強します。 （パン） 2016/03/06(日) 13:51 ---- 先日は大変お世話になりました。 ですが、また悩ましいことが起きました。自宅と会社のExcel2010の挙動が違うのです。 自宅では成功するのですが、会社ではローカルで行っても失敗します。 先の Application.FindFormat.Interior.Color = vbRed、 この部分の色が実際は RGB(89,89,89)なので、 Application.FindFormat.Interior.Color = RGB(89,89,89) にしましたが、会社の方ではだめでした。-5855577 でもだめでした。 次に元々のシートに設定されている色は、セルの書式設定の塗りつぶしの、 左から2列目の上から3番目を選択（色はRGB(89,89,89)）するのを、 マクロの記録で行った、 Selection.Interior.ThemeColor = xlThemeColorLight1 のを記述してみましたが、会社の方ではだめでした。 ですが、会社の方で成功したのは、Book2の方の、セルの書式設定の塗りつぶしのパレットを選択して、 「その他の色」をクリック→[OK]でRGB(89,89,89)を選択しつつパレットでは選択されていない状態にしたら、 Application.FindFormat.Interior.Color = RGB(89,89,89)で動作しました。 ただ、パレットの色を選択してから「その他の色」→[OK]をするのは ほかのユーザーさんが行うには面倒です。 ちなみに共有の解除も行いましたが、変わりませんでした。 If ActiveWorkbook.MultiUserEditing Then ActiveWorkbook.ExclusiveAccess Application.ActiveProtectedViewWindow.Edit End If 会社の方で RGB(89,89,89)の行を削除するにはどうしたらいいでしょうか。 分かりづらい説明で申し訳ありませんが、どうかよろしくお願いいたします。 （パン） 2016/03/15(火) 22:26 ---- >>会社の方で RGB(89,89,89)の行を削除するにはどうしたらいいでしょうか。 この意味がよくわからないのですが? コードを削除? 色のついたシート上の行を削除? いずれにしても、削除が必要なら削除すればいいのでは? 同じ色をつけていれば、色番号指定で、PCに限らず、どのPCでも、問題はないと思います。 ただ、コードでは 赤 だという処理をしても 赤 が、人それぞれ、いろんな 赤がありますのでね。 ところで、RGB(89,89,89) は 色番号 5855577 ですよね。（-5855577 とは違う色） で、いずれの色も、赤とは、ほど遠い色調ですが? いずれにしても、コードが期待する色を正しく使ってもらうというのは、なかなか難しいのかもしれません。 色つけマクロを準備して、それにマクロショートカット（たとえば a ）を割り当てておき、セル選択した後 パレットから選ばずに、 Ctrl/a とやってもらうのがいいかもしれませんね。 Sub Test() Selection.Interior.Color = vbRed End Sub （β） 2016/03/16(水) 06:37 ---- 別案です。 もし、$A$1:$U$500 の範囲内のセルの色、これが操作者によってまちまちなので 判定が困難だということであれば、その範囲内に、別の目的の色はセットされていない、 逆にいえば、どんな色であれ、色付きのセルがあれば、その行は削除するということで無理がないとすれば Findでの書式検索ではなく 1〜500 行のループ処理で、その行の A列:U列 の セルの ColorIndex を取得し 取得結果が Null あるいは xlNone以外の値なら 削除対象の行だという方式でもいけるのですが。 以下コード。書いただけで動かしていないので不具合あれば御容赦。 Sub Test3() Dim appExcel As Object Dim i As Long Dim r As Range Dim shF As Worksheet Dim shT As Worksheet Dim chk As Boolean Dim z As Variant Dim dlt As Range Set appExcel = GetObject("C:¥temp¥Book2.xlsx") Set shF = appExcel.Sheets("Sheet1") Set shT = Workbooks("Book1.xlsx").Sheets("Sheet1") '★ ここは実際のものに With shF.Range("$A$1:$U$500") For Each r In .Rows chk = False z = r.Interior.ColorIndex If IsNull(z) Then chk = True ElseIf z <> xlNone Then chk = True End If If chk Then If dlt Is Nothing Then Set dlt = r.EntireRow Else Set dlt = Union(dlt, r.EntireRow) End If End If Next End With If Not dlt Is Nothing Then dlt.Delete i = shF.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row shT.Range("D2:J2").Value = shF.Range("K" & i).Resize(, 7).Value shT.Range("D1:J1").Value = shF.Range("K" & i - 1).Resize(, 7).Value appExcel.Close False 'あとあと悪さをしないよう念のため Set appExcel = Nothing '同上 End Sub （β） 2016/03/16(水) 07:01 ---- βさん、色々とありがとうございます。 （RGB(255,0,0)はここでの架空の設定なので、忘れてください。） 会社にある Excel2010 で何台か試しましたが、なぜか IndexColor 以外の色は受け付けないようなので、 「2016/03/05(土) 15:14」の方法で RGB(89,89,89) の指定では、RGB(89,89,89) で塗られた 行のマクロでの削除はできませんでした。 （自宅のExcel2010とExcel2013では成功してました。） ちなみに色の指定は以下の3通りで試しました。 いづれも自宅では成功し、会社では失敗したものです。 Application.FindFormat.Interior.Color = RGB(89, 89, 89) Application.FindFormat.Interior.ThemeColor = xlThemeColorLight1 Selection.Interior.ThemeColor = xlThemeColorLight1 「2016/03/16(水) 07:01」のは10数枚のBookを処理するのに続けて行った際、2回目の 「Set dlt = Union(dlt, r.EntireRow)で「'Union'メソッドは失敗しました」で止まってしまいました。 また黄色等、RGB(89,89,89)以外の色も削除されてしまうので、申し訳ありませんが使うことができません。 結局、会社での動作確認は不明ですが、マクロの記録で処理することにしてみます。 Sub Test4() Dim Wb As Workbook Dim i As Long Dim shF As Worksheet Dim shT As Worksheet Set Wb = Workbooks.Open("C:¥temp¥Book2.xlsx") Set shF = Wb.Sheets("Sheet1") Windows("Book2.xlsx").Activate Sheets("Sheet1").Select ActiveSheet.Range("$A$12:$S$500").AutoFilter Field:=3, Criteria1:=RGB(89, 89 _ , 89), Operator:=xlFilterCellColor Rows("12:500").Select Selection.Delete Shift:=xlUp ActiveSheet.Range("$A$12:$S$500").AutoFilter Field:=3 Set shT = Workbooks("Book1.xlsm").Sheets("Sheet1") i = shF.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row shT.Range("D2:J2").Value = shF.Range("K" & i).Resize(, 7).Value shT.Range("D1:J1").Value = shF.Range("K" & i - 1).Resize(, 7).Value Workbooks("Book2.xlsx").Close SaveChanges:=False End Sub ですが、ExecuteExcel4Macro にこだわったせいで GetObject にしたりしていましたが、 Workbooks.Open にしたら軽くなったり、shT.Range のところも自分では書けなかったので、 とても助かりました。 連休明けの会社での動作確認が不安ですが、改めて結果報告いたします。m(_ _)m （パン） 2016/03/19(土) 11:01 ---- >>会社にある Excel2010 で何台か試しましたが、なぜか IndexColor 以外の色は受け付けないようなので 2010 で、うけいれられなかったのですか? 2003までなら、色はカラーインデックスで設定されている56色しかなく、いくら色番号を指定しても カラーインデックスに登録のない色番号の場合、近い色に置き換わってしまうので RGB(89,89,89) で色塗りしても RGB(89,89,89) にはなりませんけど、2010なら、絶対にそういうことはないはずですが? （β） 2016/03/19(土) 20:26 ---- 会社のPCのOffice はボリュームライセンスですが、IRM(Windows Right Management) というので制限がかかっているのかもしれません。 （パン） 2016/03/29(火) 22:38 ---- いや、そんなことではなく、実際に不具合が発生したPCがあるわけですよね。 そのPCでエクセルを立ち上げて処理していますよね。 その立ち上がったエクセルのバージョンが2010なのかどうかを確かめていただきたいのですが。 （β） 2016/03/29(火) 22:55 ---- 何度もすみません。会社には2010と2013しかなく、試したExcelのバージョンは2010です。 Excel2010がインストールされた2台のPCで試しましたが両方ともダメでした。 自宅の2010と2013では成功してるので、できない原因が分かりません。 ちなみに、2016/03/15(火) 22:26発言の「セルの書式設定の塗りつぶしのパレットを選択して、 「その他の色」をクリック→[OK]でRGB(89,89,89)を選択しつつパレットでは選択されていない状態にしたら、 Application.FindFormat.Interior.Color = RGB(89,89,89)で動作しました。 」 のパレットは、「セルの書式設定」→「塗りつぶし」の左から2列目の、線を跨いだ上から3番目です。 これがRGB(89,89,89)になります。 （パン） 2016/03/31(木) 00:42 ---- 絶対に、そのPCは2003 ではないということ（2007以降ではないということ） 了解しました。 基本に戻って、新規ブックの標準モジュールに以下のコードを貼り付けで、そのだめな2台で、そのパレットから色を選び 色付けしたセルを選択して Test を実行すると、どんな値が表示されますか。（上段、色番号、下段、RGBの形式） これが 89,89,89 でないとすれば、カラーパレットの別の場所を選んでいるか、 あるいは、そのPCのパレットのその場所にセットされた色が別物ということになります。 ちなみに、当方のカラーパレットで 89,89,89 になるのは 以下の ■ の場所のボタンです。 色なし □□□□・・・・・ ==================== □□□□・・・・・ □■□□・・・・・ □□□□・・・・・ Type RGBSET r As Long g As Long b As Long End Type Sub test() Dim w As RGBSET w = divRGB(Selection.Interior.Color) MsgBox Selection.Interior.Color & vbLf & "RGB(" & w.r & "," & w.g & "," & w.b & ")" End Sub Function divRGB(rgbVal As Long) As RGBSET divRGB.b = rgbVal ¥ 256 ^ 2 divRGB.g = (rgbVal - divRGB.b * 256 ^ 2) ¥ 256 divRGB.r = rgbVal - divRGB.b * 256 ^ 2 - divRGB.g * 256 End Function （β） 2016/03/31(木) 07:17 ---- βさん、色々とありがとうございます。 上記に書いていただいたMacroの結果は2台共、 5855577 RGB(89,89,89) となりました。 パレットの位置は私が分かりづらい表現をしましたが、 βさんに図で書いていただいた通り、左から2列目の、線を跨いだ上から3番目で、 RGB(89,89,89)に間違いありません。 ちょっとここで残念なお知らせです。 3月末で契約更新が切れてしまい、これ以上の検証はできなくなりました。 βさんには最後まで付き合ってくださり、何度お礼を言っても足りないくらいです。 本当にありがとうございました。 '自宅の2010と2013では、βさんのマクロ（ 2016/03/05(土) 15:14）は正常に動作しますので、 '検証にはなりませんよね。 （パン） 2016/04/04(月) 22:52... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201603/20160305005942.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97056 documents and 608292 words.
訪問者：