EXCEL2011 Objectに入れたWorksheetのエラーについて| OKWAVE

EXCEL2011 Objectに入れたWoｒ…改

お世話になります。どうもなんと言って良いのか本当に、済みませんスレットを、変えようと、して念の、ため確認に、再度走らせて、みたの、ですがコメントアウト、させていても ☆で、添付映像のエラーに、なりますもう頭が？？？？？？です兎に角エラー理由が、解りません申し訳、ありませんがお教え下さい。　　　　記 Option　Explicit Option　Base　0 Dim　Data(100,　100)　As　Long,　Ch　As　Long,　s1　As　Long,　s2　As　Long,　Ws　As　Worksheet,　ランゲ　As　Range Sub　testMain()　'　簡易テスト Dim　現状保存　As　Worksheet,　シート名　As　String 　Let　シート名　=　ActiveSheet.Name Application.ScreenUpdating　=　False 　Worksheets(シート名).Copy　after:=Worksheets(Worksheets.Count)　　'■ 　Set　現状保存　=　ActiveSheet　　　　　　　　　　　　　　　　　　　　　　　　　　　　'■ 　Set　Ws　=　Worksheets.Add() '　Worksheets(シート名).Copy　after:=Worksheets(Worksheets.Count)　　'＊□ '　Set　現状保存　=　ActiveSheet　　　　　　　　　　　　　　　　　　　　　　’□ '　Worksheets(シート名).Select　　　　　　　　　　　　　　　　　　　　'＊　現状保存.Visible　=　False '　Ws.Visible　=　False　　　　　　　　　　　　　　　　　　　　　　　'＊ Application.ScreenUpdating　=　True 　Call　ダミーデータ作成　Call　testC 　Call　testV 　Call　testE Application.DisplayAlerts　=　False 現状保存.Delete Ws.Delete Application.DisplayAlerts　=　True End　Sub Sub　ダミーデータ作成() 　With　Ws.Range("a1:cv100") 　　.Formula　=　"=RANDBETWEEN(1,10000)" 　　.Calculate 　　.Value　=　.Value 　End　With 　Let　Ws.Cells(1,　101).Formula　=　"=MIN("　&　Ws.Name　&　"!"　&　Ws.Range("a1:cv100").Address　&　")" 　Ws.Cells(1,　101).Calculate 　For　s2　=　1　To　100 　　For　s1　=　1　To　100 　　　Data(s1,　s2)　=　Ws.Cells(s1,　s2).Value 　　Next　s1 　Next　s2 　Let　Data(0,　0)　=　Ws.Cells(1,　101).Value End　Sub Sub　testC() 　Ch　=　10000 　With　Ws 　　For　s2　=　1　To　100 　　　For　s1　=　1　To　100 　　　　If　Ch　>　.Cells(s1,　s2).Value　Then　Ch　=　.Cells(s1,　s2).Value 　　　Next 　　Next 　End　With End　Sub Sub　testV() 　Ch　=　10000 　　For　s2　=　1　To　100 　　　For　s1　=　1　To　100 　　　　If　Ch　>　Data(s1,　s2)　Then　Ch　=　Data(s1,　s2) 　　　Next 　　Next End　Sub Sub　testE() 　With　Ws 　　Set　ランゲ　=　.Range(Cells(1,　1))　　　　　　　　　　　　　　　'☆ 　End　With End　Sub (※注:□の2行を　コメントから　外す、時は　同、■の2行を　コメントアウトして、下さい) 　　　　　　　　　　　　　　　　　　　　　　以上

VBA 　 Evaluateはアクティブセル向け？

度々、お世話になります Evaluateなのですが対象シートを、最前面に出して、おかないと駄目とは、聞いた事が、ないの、ですが出して、おかないとダメなのですか？下記コードは以前、頂いたものに加筆した、ものですが動かして、みるとなんか、変です一定条件下で ☆印の、所のストップに、引っかかります条件とは visibleを、FALSにすると当然の、如くダメだしそれどころか、アクティブにしておかないとどうやら正しく、計算しなかったのですまた、何か私、しでかしているで、しょうか？お教えください　　　　　　　　　　　　　　記 Option Explicit Option Base 0 Dim Ch As Long, s1 As Long, s2 As Long, Data(100, 100) As Long, Ws As Worksheet Dim dummy, i As Long, j As Long, t(8) As Long, 項試験回数 As Long Sub testMain() ' 簡易テスト Dim 現状保存 As Worksheet, シート名 As String 　Let シート名 = ActiveSheet.Name Application.ScreenUpdating = False 　Set Ws = Worksheets.Add() 　Worksheets(シート名).Copy after:=Worksheets(Worksheets.Count) 　Set 現状保存 = ActiveSheet 　Worksheets(シート名).Select 　現状保存.Visible = False '　 Ws.Visible　=　False　　　　　’此れを、戻すと　以ての外、です　　　Ws.Select　　　　　　　　　　　’此れを、外すと　ダメです Application.ScreenUpdating　=　True Application.Calculation　=　xlCalculationManual 　Call　ダミーデータ作成　Call　項試験回数設定 For　j　=　1　To　100 　Call　ダミーデータ作成　t(0)　=　Timer 　Call　AWF 　t(1)　=　Timer 　t(1)　=　t(1)　-　t(0) 　t(5)　=　t(5)　+　t(1) 　t(0)　=　Timer 　Call　Eva 　t(2)　=　Timer 　t(2)　=　t(2)　-　t(0) 　t(6)　=　t(6)　+　t(2) 　t(0)　=　Timer 　Call　RuC 　t(3)　=　Timer 　t(3)　=　t(3)　-　t(0) 　t(7)　=　t(7)　+　t(3) 　　t(0)　=　Timer 　Call　RuV 　t(4)　=　Timer 　t(4)　=　t(4)　-　t(0) 　t(8)　=　t(8)　+　t(4) Next Application.Calculation　=　xlCalculationAutomatic Debug.Print　"Worksheet..Minメソッド",　Format(1,　"0000.000"),　"/",　Format(t(5),　"###,##0.###") Debug.Print　"Evaluateメソッド　　",　Format(t(6)　/　t(5),　"0000.000"),　"/",　Format(t(6),　"###,##0.###") Debug.Print　"Loop　Range　　",　Format(t(7)　/　t(5),　"0000.000"),　"/",　Format(t(7),　"###,##0.###") Debug.Print　"Loop　Valiant　　",　Format(t(8)　/　t(5),　"0000.000"),　"/",　Format(t(8),　"###,##0.###") With　現状保存 .Range(.Cells(1,　1),　.Cells(1,　1).SpecialCells(xlLastCell)).Copy　Worksheets(シート名).Cells(1,　1) End　With Application.DisplayAlerts　=　False 現状保存.Delete Ws.Delete Application.DisplayAlerts　=　True End　Sub Sub　ダミーデータ作成() 　With　Ws.Range("a1:cv100") 　　.Formula　=　"=RANDBETWEEN(1,10000)" 　　.Calculate 　　.Value　=　.Value 　End　With 　Let　Ws.Cells(1,　101).Formula　=　"=MIN("　&　Ws.Name　&　"!"　&　Ws.Range("a1:cv100").Address　&　")" 　Ws.Cells(1,　101).Calculate 　For　s2　=　1　To　100 　　For　s1　=　1　To　100 　　　Data(s1,　s2)　=　Ws.Cells(s1,　s2).Value 　　Next　s1 　Next　s2 　Let　Data(0,　0)　=　Ws.Cells(1,　101).Value End　Sub Sub　項試験回数設定() 　Let　t(0)　=　Timer 　Let　Ch　=　0 　Do 　　Call　testW 　　Ch　=　Ch　+　1 　　Let　t(1)　=　Timer　-　t(0) 　Loop　While　t(1)　<　1 　項試験回数　=　Ch 　　Let　t(0)　=　Timer 　Let　Ch　=　0 　Do 　　Call　testE 　　Ch　=　Ch　+　1 　　Let　t(1)　=　Timer　-　t(0) 　Loop　While　t(1)　<　1 　If　項試験回数　<　Ch　Then　Let　項試験回数　=　Ch 　　Let　t(0)　=　Timer 　Let　Ch　=　0 　Do 　　Call　testC 　　Ch　=　Ch　+　1 　　Let　t(1)　=　Timer　-　t(0) 　Loop　While　t(1)　<　1 　If　項試験回数　<　Ch　Then　Let　項試験回数　=　Ch 　　Let　t(0)　=　Timer 　Let　Ch　=　0 　Do 　　Call　testV 　　Ch　=　Ch　+　1 　　Let　t(1)　=　Timer　-　t(0) 　Loop　While　t(1)　<　1 　If　項試験回数　<　Ch　Then　Let　項試験回数　=　Ch 　　Let　項試験回数　=　Application.WorksheetFunction.Ceiling(項試験回数　*　1.05,　1) End　Sub Sub　RuV() 　For　i　=　1　To　項試験回数　　Call　testC 　Next　i End　Sub Sub　RuC() 　For　i　=　1　To　項試験回数　　Call　testV 　Next　i End　Sub Sub　Eva() 　For　i　=　1　To　項試験回数　　Call　testW 　Next　i End　Sub Sub　AWF() 　For　i　=　1　To　項試験回数　　Call　testE 　Next　i End　Sub Sub　testC() 　Ch　=　10000 　With　Ws 　　For　s2　=　1　To　100 　　　For　s1　=　1　To　100 　　　　If　Ch　>　.Cells(s1,　s2).Value　Then　Ch　=　.Cells(s1,　s2).Value 　　　Next 　　Next 　　dummy　=　Ch 　　If　dummy　<>　.Cells(1,　101).Value　Then　Stop 　End　With End　Sub Sub　testV() 　Ch　=　10000 　For　s2　=　1　To　100 　　For　s1　=　1　To　100 　　　If　Ch　>　Data(s1,　s2)　Then　Ch　=　Data(s1,　s2) 　　Next 　Next 　dummy　=　Ch 　If　dummy　<>　Data(0,　0)　Then　Stop End　Sub Sub　testW() 　With　Ws 　　dummy　=　Application.WorksheetFunction.Min(.Range(.Cells(1,　1),　.Cells(100,　100)).Value) 　　If　dummy　<>　.Cells(1,　101).Value　Then　Stop 　End　With End　Sub Sub　testE() 　With　Ws 　　dummy　=　Evaluate("Min("　&　.Range(.Cells(1,　1),　.Cells(100,　100)).Address　&　")") 　　If　dummy　<>　.Cells(1,　101).Value　Then　Stop’←☆此処で止まり、ダミーが－1000等に… 　End　With End　Sub 　　　　　　　　　　　　以上

ExcelVBA Dictionaryオブジェクト

こんにちは。 Dictionaryオブジェクトについて、ご教示いただきたく質問させていただきます。あるCSVデータにおいて、A列に入力されている番号で重複をなくし、重複する番号については、B列(売上額)C列(利益額)それぞれの値を合計してSheet2に表示させるコード(test1)を書きました。データの行数が3万5千行ほどあるため、処理が終わるのに3分程かかります。今後もデータは増えていくので、処理終了までの時間をもう少し短縮したく、自分なりに調べてみたところ、Dictionaryオブジェクトというものを知り、使用例を参考にしながら見よう見まねでコード(test2)を書いて試してみたところ、処理終了まで数秒となり、かなり短縮されました。エラーも出ることなく処理できるものの、Dictionaryオブジェクトに対する理解がイマイチでして、コードの書き方等、問題ないかを知りたく質問させていただいた次第です。よろしくお願いいたします。 ------------------------------------------------------------------------------ Sub test1() Dim i As Long Dim lastRow As Long Dim ws As Worksheet Application.ScreenUpdating = False '不要データ削除 Rows("1:3").Select Selection.Delete Shift:=xlUp Range("B:Q,S:W,Y:AF").Select Selection.Delete Shift:=xlToLeft Range("A1").Select 'シート名変更・挿入 ActiveSheet.Name = "CSV" Sheets.Add After:=ActiveSheet ActiveSheet.Name = "売利集計" Set ws = Worksheets("売利集計") wS.Cells.ClearContents ws.Range("B1").Value = Worksheets("CSV").Range("B1") ws.Range("C1").Value = Worksheets("CSV").Range("C1") With Worksheets("CSV") .Range("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("A1"), unique:=True lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row With Range(ws.Cells(2, "B"), ws.Cells(lastRow, "B")) .Formula = "=SUMIF(CSV!A:A,A2,CSV!B:B)" .Value = .Value End With With Range(ws.Cells(2, "C"), ws.Cells(lastRow, "C")) .Formula = "=SUMIF(CSV!A:A,A2,CSV!C:C)" .Value = .Value End With End With Application.ScreenUpdating = True Set ws = Nothing MsgBox "売利集計完了しました。" End Sub Sub test2() Dim i As Long Dim lastRow As Long Dim ws As Worksheet Dim c As Range Dim dicS As Object Dim dicP As Object Application.ScreenUpdating = False '不要データ削除 Rows("1:3").Select Selection.Delete Shift:=xlUp Range("B:Q,S:W,Y:AF").Select Selection.Delete Shift:=xlToLeft Range("A1").Select 'シート名変更・挿入 ActiveSheet.Name = "CSV" Sheets.Add After:=ActiveSheet ActiveSheet.Name = "売利集計" '番号別集計 Set ws = Worksheets("売利集計") Set dicS = CreateObject("Scripting.Dictionary") Set dicP = CreateObject("Scripting.Dictionary") With Sheets("CSV") For Each c In .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) dicS(c.Value) = dicS(c.Value) + Val(c.Offset(, 1).Value) dicP(c.Value) = dicP(c.Value) + Val(c.Offset(, 2).Value) Next With Worksheets("売利集計") .Columns("A:C").ClearContents .Range("A1").Resize(, 3).Value = Worksheets("CSV").Range("A1").Resize(, 3).Value .Range("A2").Resize(dicS.Count).Value = WorksheetFunction.Transpose(dicS.keys) .Range("B2").Resize(dicS.Count).Value = WorksheetFunction.Transpose(dicS.Items) .Range("C2").Resize(dicP.Count).Value = WorksheetFunction.Transpose(dicP.Items) End With End With Set dicS = Nothing Set dicP = Nothing MsgBox "売利集計完了しました。" End Sub

ExcelVBA　.cells(…　が働きません

お世話になりますメモリーの、壁と格闘して、います其の、中で OfficeTANAKA様の http://officetanaka.net/excel/vba/tips/tips71.htm の、ページを拝見し Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS) と、モジュールに、書き加えた、ところ With　Ws　　　↓此処、メソットがダメ　With　.Range(.cells(… が、突如エラーになり始めました Private Declare S… を、外して全て、元通りにしても回復、しません回復可能で、しょうか？宜しくお願い、します　　　　　　　　　　　　　　　　　記 Option　Explicit Option　Base　0 Private　Declare　Sub　GlobalMemoryStatus　Lib　"kernel32"　(lpBuffer　As　MEMORYSTATUS) '↑　　↑　　↑　　↑ '此れを、加えると Type　変数取得順速度差を減らす　s1　As　Long 　s2　As　Long 　Ch　As　Long 　du　As　Long 　St　As　String 　Rg　As　Range End　Type Const　n　As　Long　=　2000 Dim　lp　As　変数取得順速度差を減らす,　Data(1　To　n,　1　To　n)　As　Long,　k　As　Long,　Ws　As　Worksheets Sub　ダミーデータ作成1() 　Set　Ws　=　Worksheets.Add() 　Worksheets("Sheet1").Select 　With　Ws’　　　↓此処で、エラー　　With　.Range(.Cells(1,　1),　.Cells(n,　n)) 　　　Let　lp.St　=　"Min("　&　Ws.Name　&　"!"　&　.Address　&　")" 　　End　With 　　For　k　=　0　To　Int(n　/　100)　-　1 　　　For　lp.s2　=　1　To　100 　　　　For　lp.s1　=　1　To　n 　　　　　With　.Cells(k　*　100　+　lp.s2,　lp.s1) 　　　　　　.Formula　=　"=RANDBETWEEN(1,"　&　n　&　")" 　　　　　　.Calculate 　　　　　　.Value　=　.Value 　　　　　　Data(k　*　100　+　lp.s2,　lp.s1)　=　.Value 　　　　　End　With 　　　　Next　lp.s1 　　　Next　lp.s2 　　　Worksheets("Sheet1").Range("c1").Value　=　k 　　　Application.DisplayAlerts　=　False 　　　ThisWorkbook.Save 　　　Application.DisplayAlerts　=　True 　　Next　k 　　Set　lp.Rg　=　.Range(.Cells(1,　1),　.Cells(n,　n)) 　End　With End　Sub 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　以上

データ検索ネスト　Excel VBA

excel2003でデータ検索の処理をするというマクロをVBAで作成したいのですが、うまく動作しません。自作のVBAを記載してみましたので何が原因なのか教えてください。初心者です、よろしくお願いします。 Sub データ検索() Dim i As Integer, j As Integer, k As Integer, l As Integer Dim myRange As Range Dim IngLastrow As Long IngLastrow = Range("A65536").End(xlUp).Row For i = 3 To IngLastrow For j = 3 To 25 For k = 8 To 53 For l = 3 To 9 Set myRange = Worksheets("データベース").Cells(i, "o").Find(what:=Worksheets("コード").Cells(j, "o").Value, _ LookIn:=xlValues) If Not myRange Is Nothing Then Worksheets("予定").Cells(k, l).Value = myRange.Offset(, -12).Value End If Next l Next k Next j Next i End Sub

エクセルの複数条件抽出

エクセルで複数条件のカウントをしようと思い、下のマクロを作成しました。うまくカウントができないのですが、どこらへんが間違っていますでしょうか？（実際にはもっと多くのデータで利用を予定しており、小さいものでテストしています）よろしくお願いします。 Dim c1 As String Dim c2 As String Dim ans As Long Dim ws As Worksheet Dim b As Long, a As Long Set ws = Worksheets("date") For b = 2 To 4 For a = 3 To 5 c1 = Cells(a, 1).Value c2 = Cells(2, b).Value With ws.Range("B2:C7") ans = Evaluate("sumproduct((" & .Columns("c").Address & "=""" & c1 & """)*(" & .Columns("B").Address & "=""" & c2 & """))") Worksheets("a").Cells(a, b).Value = ans End With Next a Next b End Sub

VBAの解説

お世話になります値、セルの操作ですが列数等の変更が生じたため変更を求められています。下記ＶＢＡ判りやすく説明できる方お願い致します。 Sub Macro1() Dim idxR, idxC, ptr As Integer Dim ws As Worksheet Set ws = ActiveSheet Worksheets.Add after:=ws ptr = 2 With ws .Rows(1).Copy Destination:=Range("A1") For idxR = 2 To .Range("A65536").End(xlUp).Row Cells(ptr, "A").Value = .Cells(idxR, "A").Value For idxC = 2 To 255 Step 2 If .Cells(idxR, idxC) = "" Then Exit For Else .Cells(idxR, idxC).Resize(1, 2).Copy Destination:=Cells(ptr, "B") ptr = ptr + 1 End If Next idxC Next idxR End With End Sub

VBA 値、セル操作

お世話になります [現状] 実行させると 1列目を残して2列づつ処理をさせています Sub Macro1() Dim idxR, idxC, ptr As Integer Dim ws As Worksheet Set ws = ActiveSheet Worksheets.Add after:=ws ptr = 2 With ws .Rows(1).Copy Destination:=Range("A1") For idxR = 2 To .Range("A65536").End(xlUp).Row Cells(ptr, "A").Value = .Cells(idxR, "A").Value For idxC = 2 To 255 Step 2 If .Cells(idxR, idxC) = "" Then Exit For Else .Cells(idxR, idxC).Resize(1, 2).Copy Destination:=Cells(ptr, "B") ptr = ptr + 1 End If Next idxC Next idxR End With End Sub [判らないこと] 前７列を残して（A:G) 8列目から（H列）より9列づつ処理をさせたいのですが判らなく大変困っております。どなたかご教授よろしくお願いします。

処理時間がかかりすぎます

いろいろ調べながらマクロを書いたのですが時間がかかりすぎます。どのうようにすれば時間短縮が図れるのでしょうか。 Sub sample() Dim tuki As Integer Dim bango As Integer Dim tukihi As Integer Dim c As Range For tuki = 1 To 12 For bango = 11 To 1000 For tukihi = 14 To 19 With Worksheets(Format(tuki) & "月").UsedRange.Rows(3) Set c = .Find(what:=Worksheets("年間予定表").Cells(bango, tukihi).Value, LookIn:=xlValues, LookAt:=xlWhole) If Not c Is Nothing Then Worksheets("年間予定表").Range("N1") = c.Address Worksheets(Format(tuki) & "月").Range(c.Address).Offset(bango - 3, 0) = _ Worksheets("年間予定表").Cells(bango, 3).Value & _ Worksheets("年間予定表").Cells(bango, 2).Value & _ " , " _ & Worksheets("年間予定表").Cells(bango, 21).Value End If End With Next tukihi Next bango Next tuki End Sub Sub youbi_s

ファイルオープン時のマクロが一部実行されない

いつも回答して頂き、ありがとうございます。感謝感謝です。ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub

マクロが思うように動きません

エクセル2007です。初心者です。マクロが思うように動きません。指定のセルが空白の場合、msgboxを表示して、処理を抜ける空白でない場合は、処理をつつける。と言う事をしたいです。 with～の後が問題だと思うのですが・・ Sub 受注履歴書き込み() Dim ws01 As Worksheet, ws02 As Worksheet Dim r As Long, c As Integer, tmp As Long Set ws01 = Worksheets("受注書") Set ws02 = Worksheets("受注履歴") ws01.Activate With ws01 If .Range("C2").Value = "" _ And .Range("M2").Value = "" _ And .Range("M11").Value = "" _ And Worksheets("粗利報告書").Range("D3").Value = "" Then MsgBox "受注Noが空白です。処理を中止します。" Exit Sub ws02.Cells(r, 1).Value = .Range("C2").Value ' 受注No ws02.Cells(r, 9).Value = .Range("A40").Value ' 備考 ws02.Activate End If End With End Sub 採点願えますでしょうか？宜しくお願い致します。

VBA Range・Cellsプロパティについて

下記のコードについて質問致します。 Sub 特定のセルをコピー() Dim rw2 As Long Dim rw1 As Long Dim newdate As Date With Worksheets("steet1") rw2 = .cells(.Rows.Count, "c").End(xlUp).Row newdate = .Range("c" & rw2).value For rw1 = rw2 - 1 To 1 Step -1 If .Range("c" & rw1).value <> newdate Then Exit For Next rw1 .Range(.cells(rw1 + 1, 1), .cells(rw2, 1)).Copy 　　　 '(1) Worksheets("steet2").Range("v6").PasteSpecial xlValue End With End Sub (1)部分のコードの意味が分かりません。よろしくお願いします。

Excel VBAで検索（Win2000 Excel2000）

現在、下記のようなコードを書いています。データテーブルの縦と横の検索値を探してその列数と行数を返したいのですが、下記の Sub検索1 と Sub検索2 を1つのSubで実行させるにはどうしたらよいのでしょうか？よろしくお願い致します。 ----------------------------------------- Sub 検索1() Worksheets("Data").Activate Dim x As Integer For x = 3 To 22 If Cells(2, x).Value >= 12 Then MsgBox x Exit Sub End If Next MsgBox "見つかりません" End Sub --------------------------------------------- Sub 検索2() Worksheets("Data").Activate Dim i As Integer For i = 4 To 42 If Cells(i, 2).Value = "A" Then MsgBox i Exit Sub End If Next MsgBox "見つかりません" End Sub

エクセル2007 参照セルの値が認識されない

エクセル2007の環境で下記マクロを実行すると、アクティブシートのセルA1に数字が入っている場合、Sheet1のセルA1に値を転記してもそのセルA1の値をVLOOKUP関数で参照できません。マクロに問題があるためなのか何処に問題があるのか分からないので教えてください。宜しくお願いいたします。【sheet】はアクティブシートの3行目から1000行目までのA列のセルをクリックしたらセルA1に値を表示その後、下記【モジュール】を使用し、アクティブシートのセルA1が空白の場合、 A列の数値をSheet1のセルA1に転記し、アクティブシートのA列の数値が空白になるまで循環する。 Sheet1のセルA1の値をVLOOKUP関数で参照した内容を表示、印刷します。 ----------------------------------------------------------------- '【sheet】 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Count > 1 + IsEmpty(.Value) Then Exit Sub If Application.Intersect(.Cells, Range("A3:A1000")) Is Nothing Then Exit Sub ActiveSheet.Cells(1, 1).Value = .Value End With End Sub ----------------------------------------------------------------- '【モジュール】 Sub TEST() Dim myBtn As Integer Dim myMsg As String, myTitle As String Dim WS1 As Worksheet, WS2 As Worksheet Dim i As Long myMsg = "●●●" myTitle = "確　認" myBtn = MsgBox(myMsg, vbYesNo + vbExclamation, myTitle) If myBtn = vbYes Then Set WS1 = ActiveSheet Set WS2 = Sheet1 If WS1.Cells(1, 1).Value = "" Then With WS1 For i = 3 To 65536 If .Cells(i, 1).Value = "" Then Exit For WS2.Cells(1, 1).Value = .Cells(i, 1).Value WS2.Cells(1, 2).Value = ActiveSheet.Name 'WS2.PrintOut Copies:=1 Next i End With ElseIf WS1.Cells(1, 1).Value >= 1 Then WS2.Cells(1, 1).Value = WS1.Cells(1, 1).Value WS2.Cells(1, 2).Value = WS1.Name 'WS2.PrintOut Copies:=1 Else End If End If End Sub -----------------------------------------------------------------

【Excel】リストボックスにデータを重複せず昇順に表示する方法

教えてください。ユーザーフォームにリストボックス（Listbox1）があり、日付が昇順で入力されるようになっています。ただし、この日付データは重複が多いため重複されないよう表示しようと下記のコードを記述しましたが「実行時エラー1004　アプリケーション定義またはオブジェクト定義のエラーです」と表示されてしまいます。これを回避し、実行させるためにはどういう風に記述を修正したらよいでしょうか？ ================================================================ Private Sub UserForm_Initialize() Dim i As Long For i = 2 To 2000 ListBox1.AddItem Worksheets("データ").Cells(i, 1) Dim myValue As Variant Dim myRng As Range, myCell As Range Set myRng = Worksheets("データ").Cells(i, 1).End(xlUp) myValue = myRng.Value Application.ScreenUpdating = False myRng.Sort Worksheets("データ").Cells(i, 1), xlAscending, Header:=xlYes With ListBox1 .Clear For Each myCell In myRng.Resize(myRng.Rows.Count - 1).Offset(1) _ .SpecialCells(xlCellTypeVisible) .AddItem myCell.Value Next .ListIndex = 0 End With Next i ListBox1.ListIndex = 0 End Sub ================================================================

If Like Then条件式可変の場合の処理

VBAにてSheet1の指定された番地にあるセルの値がSheet2のセル範囲にない場合はセルに色をつけると言うマクロを組んでいます。 Sub test() Dim i,z As Integer Dim WS As Worksheet Dim LastRow As Integer Dim Word1,Word2,Word3 As String Set WS = Worksheets("Sheet1") Word1 = WS.Cells(1,16).Value Word2 = WS.Cells(1,17).Value Word3 = WS.Cells(1,18).Value with Worksheets("Sheet2") LastRow = .Range("A" & Rows.Count).End(xlUp).Row For i = 3 To LastRow For z = 6 To 9 If .Cells(i,z).Value Like "*" & Word1 & "*" Or _ .Cells(i,z).Value Like "*" & Word2 & "*" Or _ .Cells(i,z).Value Like "*" & Word3 & "*" Then Else .Cells(i,z).Interior.ColorIndex = 6 End If Next Next End Sub 上記のマクロで変数Word1,2,3が1つだけの場合もあれば Word10まである場合も有り式を変更する必要が有ります。。この場合、If Like 変数 Or の部分をフレキシブルに対応させる為にはどの様な式を書けば良いでしょうか(ToT)？申し訳ありませんがご教授下さい(ToT) 宜しくお願い致します。

横にコピーするには・・。

教えてください・・。 01.xls・02.xls・03.xlsとあり、その中のシート（01・02・03）をコピーして、全部というシートにまとめたいと思っています。列にデータを追加したいのですが、行にデータが追加されてしまいます・・。どうしたらいいのか教えてください。 01のシートがＡからＤまで 02のシートがＥからＧまで 03のシートがＨからＬまでとコピーをしたいと思っています・・。 --------- PathName = ThisWorkbook.Path & "\" ArrBook = Array("01.xls", "02.xls", "03.xls") For i = LBound(ArrBook) To UBound(ArrBook) Workbooks.Open PathName & ArrBook(i) Next Set WS(1) = Workbooks("01.xls").Worksheets("01") Set WS(2) = Workbooks("02.xls").Worksheets("02") Set WS(3) = Workbooks("03.xls").Worksheets("03") Set WS(4) = ThisWorkbook.Worksheets("全部") With WS(4) .Cells.ClearContents .Cells(1, 1) = "Ａ" .Cells(1, 2) = "B" .Cells(1, 3) = "C" .Cells(1, 4) = "D" .Cells(1, 5) = "E" .Cells(1, 6) = "F" .Cells(1, 7) = "G" .Cells(1, 8) = "H" .Cells(1, 9) = "I" .Cells(1, 10) = "J" .Cells(1, 11) = "K" .Cells(1, 12) = "L" .Cells(1, 13) = "M" .Cells(1, 14) = "N" .Cells(1, 15) = "O" .Cells(1, 16) = "P" .Cells(1, 17) = "Q" LastRow(1) = WS(1).Range("A65536").End(xlUp).Row LastRow(2) = WS(2).Range("A65536").End(xlUp).Row LastRow(3) = WS(3).Range("A65536").End(xlUp).Row For i = 1 To 3 LastRow(4) = .Range("A65536").End(xlUp).Row + 1 WS(i).Rows("2:" & LastRow(i)).Copy .Cells(LastRow(4), 1) LastRow(4) = .Range("A65536").End(xlUp).Row End With For i = LBound(ArrBook) To UBound(ArrBook) Workbooks(ArrBook(i)).Close SaveChanges:=False Next End Sub

VBA　高速化

以下のコードを改良して早く処理できるようにしたいです。素因数分解をして、素因数の数を数えるプログラムです。 Sub 素因数を数える() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim I As Long, j As Long, cnt As Long, wS As Worksheet, k As Long, Set wS = Worksheets("Sheet2") k = Worksheets("Sheet1").Range("A100010").End(xlUp).Row - 1 For dd = 3 To k Call aaa(Range("A" & dd)) Next dd Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub aaa(ByVal Target As Range) Set wS = Worksheets("Sheet2") If Intersect(Target, Range("A:A")) Is Nothing Or Target.Count > 1 Then Exit Sub With Target If Not IsNumeric(.Value) Then Exit Sub If .Value Mod 1 = 0 Then Range("D1") = .Value For I = 1 To wS.Cells(Rows.Count, "A").End(xlUp).Row Do While Cells(Rows.Count, "D").End(xlUp) Mod wS.Cells(I, 1) = 0 cnt = cnt + 1 Cells(Rows.Count, "D").End(xlUp).Offset(1) = Cells(Rows.Count, "D").End(xlUp) / wS.Cells(I, 1) Loop If Cells(Rows.Count, "D").End(xlUp) = 1 Then Exit For Next I End If .Offset(, 1) = cnt End With Range("D:D").Clear End Sub 以前教えていただいたコードを使って書きました。どういう状況で使っているかといいますと、シート1のＡ列に自然数を2から順番に並べ、シート2のＡ列に素数を並べておき、プログラムを実行すると、Ｂ列に素数の数が表示されるという具合です。大変役に立っていたのですが、10萬ほどのデータを扱おうとすると、自分のコンピュータでは時間がかかりすぎます。そこでコードを改良して高速化をしたいのです。いま考えられる改良点は、 1、Ｄ列を使って行っている処理をメモリで行うようにして、セルへのアクセスを省けないか 2、aaaの5行目の、"wS.Cells(Rows.Count, "A").End(xlUp).Row"この処理を簡単な変数の処理で代用できないかということです。他にも高速化できる方法があれば教えてください。よろしくお願いします。

EXCEL2010エラーVBA

下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391　がエラーメッセージです。何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub

Excel VBA でExecuteExcel4Macro("GET.OBJECT(48,

エクセル2000です。以前、ワークシートに配置したフォームツールのラベルの参照元を取得するマクロをご教示いただき、以下のTest01は問題なく作動しています。 Sub test01() Dim obj As Object Dim i As Integer Dim obj_n As String 'オブジェクトの名前 With ActiveSheet For Each obj In .Labels i = i + 1 .Cells(i, 2) = obj.Name: obj_n = obj.Name .Cells(i, 3) = obj.TopLeftCell.Address 'GET.OBJECT で、リンクがないものを取ると、False になる .Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)") .Cells(i, 6) = obj.OnAction Next End With End Sub 今回、同一シートではなく別シートに表示させようと以下のTest02を書いたのですが、やってみると .Cells(i, 5) はすべて#VALUE!エラーになってしまいました。 ExecuteExcel4Macro（"GET.OBJECT(48～がどのようなものかわからずやっているので応用がききません。（そもそも48って？）どのようになおしたらよいのかご教示いただければ幸いです。 Sub test02() Dim obj As Object Dim i As Integer Dim obj_n As String Dim ws As Worksheet, ns As Worksheet Set ws = ActiveSheet Set ns = Worksheets.Add With ns For Each obj In ws.Labels i = i + 1 .Cells(i, 2) = obj.Name: obj_n = obj.Name .Cells(i, 3) = obj.TopLeftCell.Address .Cells(i, 5) = ExecuteExcel4Macro("GET.OBJECT(48,""" & obj_n & """)") .Cells(i, 6) = obj.OnAction Next End With End Sub

EXCEL2011 Objectに入れたWorksheetのエラーについて

EXCEL2011 Objectに入れたWork…

質問者が選んだベストアンサー

お礼 2017/05/12 07:55

補足 2017/05/12 08:09

関連するQ&A

EXCEL2011 Objectに入れたWoｒ…改

VBA 　 Evaluateはアクティブセル向け？

ExcelVBA Dictionaryオブジェクト

ExcelVBA　.cells(…　が働きません

データ検索ネスト　Excel VBA

エクセルの複数条件抽出

VBAの解説

VBA 値、セル操作

処理時間がかかりすぎます

ファイルオープン時のマクロが一部実行されない

マクロが思うように動きません

VBA Range・Cellsプロパティについて

Excel VBAで検索（Win2000 Excel2000）

エクセル2007 参照セルの値が認識されない

【Excel】リストボックスにデータを重複せず昇順に表示する方法

If Like Then条件式可変の場合の処理

横にコピーするには・・。

VBA　高速化

EXCEL2010エラーVBA

Excel VBA でExecuteExcel4Macro("GET.OBJECT(48,

注目のQ&A

カテゴリ
一覧

専門家に質問してみよう
専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

EXCEL2011 Objectに入れたWorksheetのエラーについて

EXCEL2011 Objectに入れたWork…

質問者が選んだベストアンサー

お礼 2017/05/12 07:55

補足 2017/05/12 08:09

関連するQ&A

EXCEL2011 Objectに入れたWoｒ…改

VBA Evaluateはアクティブセル向け？

ExcelVBA Dictionaryオブジェクト

ExcelVBA .cells(… が働きません

データ検索ネスト Excel VBA

エクセルの複数条件抽出

VBAの解説

VBA 値、セル操作

処理時間がかかりすぎます

ファイルオープン時のマクロが一部実行されない

マクロが思うように動きません

VBA Range・Cellsプロパティについて

Excel VBAで検索（Win2000 Excel2000）

エクセル2007 参照セルの値が認識されない

【Excel】リストボックスにデータを重複せず昇順に表示する方法

If Like Then条件式可変の場合の処理

横にコピーするには・・。

VBA 高速化

EXCEL2010エラーVBA

Excel VBA でExecuteExcel4Macro("GET.OBJECT(48,

注目のQ&A

カテゴリ 一覧

専門家に質問してみよう 専門家登録

あなたにピッタリな商品が見つかる！ OKWAVE セレクト

VBA 　 Evaluateはアクティブセル向け？

ExcelVBA　.cells(…　が働きません

データ検索ネスト　Excel VBA

VBA　高速化

カテゴリ
一覧

専門家に質問してみよう
専門家登録