- 締切済み
Excel（VBAを使用して書式の大量コピー）
お世話になっております 以下の内容を行っているのですが、処理が遅くもっと効率の 良い方法がないかご教授いただければと思います win2000 Excel200 ExcelのA列のデータが１００００件ほど入っております ただし、IF文などの書式が入ってる行と入ってない行があり 書式の入っている行だけ新しい書式を設定したいと思ってます For intCnt = 1 to 10000 もしも書式が入っていたら新しい書式にする IF Left(Trim(Range("A" & intCnt).FormulaR1C1), 1) = "=" Then range(A1) = "新しい書式" End if next このような感じで行ってますが、処理に時間がかかります なんとか、速度UPを考えてますが、何か良い案はございますでしょうか？ 宜しくお願い致します
- Tori_Mayo
- お礼率85% (29/34)
- その他（プログラミング・開発）
- 回答数3
- ありがとう数3
- みんなの回答 （3）
- 専門家の回答
みんなの回答
- hige_082
- ベストアンサー率50% (379/747)
- hige_082
- ベストアンサー率50% (379/747)
＞IF文などの書式が入ってる行と入ってない行があり 書式ではなく、数式ですよね Excelの機能を使用すると早いよ Sub Macro1() Range("a:a").SpecialCells(xlCellTypeFormulas, 23) = "=A1+B1" End Sub 参考まで
お礼
返信遅れましてすいません アドバイスありがとうございます 上記内容でマクロを実行したのですが、エラーが表示され 実行できませんでした。。。
- kmetu
- ベストアンサー率41% (562/1346)
式ですよね。置換を利用すればいかがでしょう 2000でもいけると思うのですが 検索する文字列 =* 置換後の文字列 新しい式
お礼
返信が遅くなりました アドバイスありがとうございます 置換処理でうまくいきました。 ありがとうございましたm(_ _)m
関連するQ&A
- Excel2002 配列の取得
いつもお世話になっております。 Excelのデータを行単位で配列に書き換える処理を VBAで記述しています。 '****************************************************** '*** 行のループ処理(見出し行を含まず2行目から) For intCnt = 1 To intRow '*** 列のループ処理 For intCnt2 = 1 To 58 '*** セル範囲を配列変数に格納する varUPDT = wsWS.cells(intCnt, 1).Resize(intCnt, 58).Value If intCnt2 = 1 Then varDATA = "('" & varUPDT(intCnt, intCnt2) & "'" Else If varUPDT(intCnt, intCnt2) = Empty Then varUPDT(intCnt, intCnt2) = 0 Else End If '*** テキスト型の列を指定 If intCnt2 = 2 Then varDATA = varDATA & ",'" & varUPDT(intCnt, intCnt2) & "'" Else varDATA = varDATA & "," & varUPDT(intCnt, intCnt2) End If End If Next intCnt2 varDATA = varDATA & ")" Next intCnt '****************************************************** 取得した結果を見ると、なぜか奇数行のみが 取得されています。 行の変数(IntCnt)は1ずつ増えていっているのに不思議です。 間違いをご指摘いただきたく存じます。 どうぞよろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡについて
http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを Ｅ列に日付 Ｆ列に売上 Ｇ列に結果 でやりたいのですが この時Ａ列～Ｃ列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡで最小値を求めたいのですが
下記はある表の最大値を求めるものですが 同様の条件で最小値を求めようと思い 「MAX」の箇所を「MIN」差し替えてできると思っていたのですが 最小値がのかわりに「0」が表示されてしまいます。 そのように修正すればよいでしょうか？ private sub worksheet_change(byval Target as excel.range) if target.cells(1) = "" then exit sub if target.address = "$A$1" then Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With elseif target.address = "$E$1" then Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With end if end sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBA
A列を基準にBC列が空白ならAの数値を入れて、A>BならB列を更新、A<CならC列を更新 A列が数値以外ならその行をスキップ、という処理をしたいのですが Option Explicit Dim A As Range, B As Range, C As Range Dim i As Long Sub test() For i = 1 To 10 Set A = Cells(i, 1) Set B = A.Offset(0, 1) Set C = A.Offset(0, 2) If IsNumeric(A) Then Else Exit Sub End If If B.Value = "" Then B.Value = A.Value If C.Value = "" Then C.Value = A.Value If A.Value > B.Value Then B.Value = A.Value If A.Value < C.Value Then C.Value = A.Value Next i End Sub とすると数値以外の行の時点で停止してしまいます。 その行を飛ばして次の行に進むにはどうしたらいいのでしょうか？
- ベストアンサー
- Visual Basic
- エクセルVBAでクリックしたセルのみ書式を変えたいのです。
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Target.Row <= 11 And Target.Column <= 11 Then With Selection .Interior.ColorIndex = 3 .Font.ColorIndex = 2 .Font.Bold = True End With End If End Sub これで出来るのですが、問題は別のセルに移動しても書式は変ったままなのです。（当り前ですが） 書式を変えるのはあくまで選択されている間だけにしたいのです。 どのようにすればよいのでしょうか？ エクセル９７です。
- 締切済み
- オフィス系ソフト
- この場合エクセルVBAでどう書けばいいでしょうか？
あるシートのH列で、H21からH46のあいだで"False"がある行を非表示にしたいのです。 下記の冗長なマクロでもそうなりますが、For Nextというのを使うともっと簡潔に記述できると思うのですが、初心者のためよくわかりません。ご教示ください。 また、下記の式はシートが保護されていると働きませんが、保護したシートでも動く方法があればそれもあわせて教えていただけると幸いです。 エクセルは95です。 Sub 空白行非表示() G% = Sheets("見積書").Range("H48").Value With Sheets("見積書") Rows("19:47").RowHeight = G% If Range("H21") = False Then Rows("21").EntireRow.Hidden = True End If If Range("H22") = False Then Rows("22").EntireRow.Hidden = True End If If Range("H23") = False Then Rows("23").EntireRow.Hidden = True End If If Range("H24") = False Then Rows("24").EntireRow.Hidden = True End If 途中、繰り返しのため省略 If Range("H42") = False Then Rows("42").EntireRow.Hidden = True End If If Range("H43") = False Then Rows("43").EntireRow.Hidden = True End If If Range("H44") = False Then Rows("44").EntireRow.Hidden = True End If If Range("H45") = False Then Rows("45").EntireRow.Hidden = True End If If Range("H46") = False Then Rows("46").EntireRow.Hidden = True End If End With End Sub
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAでコピーのやり方
シート１のAL列の3行目以降の中から0以外の 値が入っているAJ列～AN列の行を全てコピーして、 シート２のＢ列～Ｆ列に貼り付けたいです。 シート２のＢ列～Ｆ列の7行目から下にコピーした値を入れていきたく、 値が入っていたらその次の行に貼り付けたいです。 例えば、7行目～15行目まで値が入っていたら、16行目から貼り付けるようにしたいです。↓のように書いてみたのですが、 コピーしている状態になるだけで、シート2の方へ貼り付けができない状態です。 また、オブジェクトが必要ですと表示が出ます。 どこをどうなおしたらいいでしょうか。 文章がわかりにくく申し訳ありません。 回答よろしくお願いいたします。 sub 値をコピー() Dim rTargetRange As Range, ii As Long Set rTargetRange = Nothing For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row If (Cells(ii, "AL").Value <> 0) Then If (rTargetRange Is Nothing) Then Set rTargetRange = Cells(ii, "AJ").Resize(, 5) Else Set rTargetRange = Application.Union(rTargetRange, Cells(ii, "AJ").Resize(, 5)) End If End If Next With Worksheets("sheet2") With .Cells(.Rows.CountLarge, "B").End(xlUp) If (.Row = 1 And .Value = "") Then rTargetRange.Copy .Offset(0) Else rTargetRange.Copy .Offset(1) End If End With End With End Sub また、↓のような違ったコードも試しましたが、 うまくいきませんでした。 N=Sheet2.Cells(Rows.CountLarge, "AL").End(xlUp).Row+1 SHEET1.SELECT For ii = 4 To Cells(Rows.CountLarge, "AL").End(xlUp).Row If Cells(ii, "AL").Valu e <> 0 Then RANGE("AJ" & ii & ":AN" & ii).COPY SHEET2.RANGE("B" & N) N=N+1 END IF NEXT
- 締切済み
- Excel（エクセル）
- VBAで処理フラグの立て方
こういった条件でやりたいのですがうまくいきません・・・ 処理フラグの立て方は間違っていないと思うのですが・・・ ちょっとセルとかは変えてあります。 もしE3の値が４で割り切れたら8行目を削除し次の処理は行わない もしE3の値が４で割り切れなかったらE4の値が４で割り切れるか処理をする。 割り切れたら18行目を削除 E3とE4の値両方が４で割り切れなかったら8行目を削除し1行あがるので17行目を削除したいです Sub rdlt() If Range("I1").Value = 0 Then Range("I1").Value = 1 '処理は一度きり If Range("E3").Value Mod 4 = 0 Then Rows("8:8").delete '4で割れたとき8行目を削除 Range("J1").Value = 1 '4で割れたときは次の処理用にフラグ End If If Range("J1").Value = 0 Then 'E3が4で割れなかったときは処理する If Range("E4").Value Mod 4 <> 0 Then Rows("18:18").delete Range("J1").Value = 1 End If End If End If End Sub
- ベストアンサー
- Visual Basic
- エクセルVBAでの繰り返し処理について
１行目には１ヶ月分の日付がはいっています。 ２行目にはWEEKDAY関数で１行目の日付の曜日をいれています。 ３行目に月曜日（WEEKDAY関数では２）なら公休日の"公"と表示したいのですがどのようにしたらよいでしょうか？ Sub 公休日() If Range("A2").Value = 2 Then Range("A3").Value = "公" End If End Sub このような作業を繰り返すにはどうすればよいでしょうか？ 補足として、エクセル2007を使用しています。 ３行目には数字を入力するためIF関数を使うことができません。
- ベストアンサー
- Visual Basic
- Excel VBA IF文がうまく動作しないわけがわかりません…
未熟な私ですが… セルC２の文字列の6・7桁目に入っている文字により、8桁目の文字を 置き換えるものをつくりました。 例えば、セルのC2に、IRCD-311234 という値があれば IRCD-31A234 にしなさいというものです しかし、 ElseIf の条件式にあてはまるものがでてきても、 すべて最初のIFの条件式にしてしまい、Elseifに反応してくれません。 ****************************************************** Sub 変換() Dim DAT As Range Dim CAR As String If Mid(Range("C2").Value, 6, 2) = 31 Or 32 Or 33 Then For Each DAT In Range("A1:P40") CAR = CStr(DAT) If Left(CAR, 5) = "IRCD-" Then CAR = Left(CAR, 7) & "A" & Right(CAR, Len(CAR) - 8) DAT.Value = CAR End If Next ElseIf Mid(Range("C2").Value, 6, 2) = 37 Or 38 Or 39 Then For Each DAT In Range("A1:P40") CAR = CStr(DAT) If Left(CAR, 5) = "IRCD-" Then CAR = Left(CAR, 7) & "B" & Right(CAR, Len(CAR) - 8) DAT.Value = CAR End If Next End If End Sub ****************************************************** 本やネットを見ているのですが、何が悪いのか私にはわかりません…。 どうかご指導をお願いいたします。
- ベストアンサー
- Visual Basic
お礼
お世話になっております >お役に立てず、すみません いえいえ、とんでもございません。 >どのような、エラーが出たのでしょうか？ 「アプリケーション定義またはオブジェクトの定義のエラーです」 と表示されてしまいましたが、ActiveSheet.を設定で出来ました すみませんでした。 実は今別件が出て戦っているのですが、このSpecialCellsを知ったおかげで 凄く助かっております。 ただあと少しのところで出来ないので新規でまた質問を立ち上げる予定です アドバイスありがとうございましたm(_ _)m