Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

230 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77846】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/12(火) 11:54 -


	引用なし

	パスワード

▼Jaka さん：
>>　　UserForm1.Show
>
>の前に
>Cancel = True
>を入れてみると？
>
>久々の登場で勘。

ありがとうございます。
やってみましたが駄目でした。

・ツリー全体表示


	【77845】Re:excel2003で作ったVBAの誤作動？バグ...

Jaka - 16/1/12(火) 11:43 -


	引用なし

	パスワード

>　　UserForm1.Show

の前に
Cancel = True
を入れてみると？

久々の登場で勘。

・ツリー全体表示


	【77844】Re:excel2003で作ったVBAの誤作動？バグ...

たろう - 16/1/12(火) 10:55 -


	引用なし

	パスワード

▼β さん：
検証ありがとうございます。

再検証したところユーザーフォームの開き方に問題があるようです。
通常、セルをダブルクリックしたらユーザーフォームが開くように下のコードを入れています。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
　　UserForm1.Show
End Sub

このコード以外の開き方だとおっしゃるとおり問題は起きませんでした。
ただ何が問題なのかよくわかりません。。

・ツリー全体表示


	【77843】Re:貼り付けたHTMLのテキストを取得したい

YH - 16/1/9(土) 19:19 -


	引用なし

	パスワード

▼γ さん：

γ 様。
厳しくも温かきご意見ありがとうございます。そして、大人の対応をしていただき感謝します。勉強になりました。

>> 皆様、はじめまして。彷徨い続けて、ここへ流れてきました。
>> こういう場所への投稿は初めてですので、失礼があったらお許しください。
>> 本題へ入ります。
>> 下記のマクロですが、MsgBoxに表示させるのではなく、
>> 例えば、セルA１から下へ、貼り付けていくのにはどうすればよいでしょうか？
>> 初心者で大変困っております。
>> どうぞよろしくお願いします。
>>
> > >'=======================================================
> >　>Sub testtest()
> >　>　　Dim shp As OLEObject
> >　>　　With ActiveSheet
> >　>　　　 For Each shp In .OLEObjects
> >　>　　　　　If UCase(TypeName(shp.Object)) = UCase("htmltext") Or UCase(TypeName(shp.Object)) = UCase("htmltextarea") Then
> >　>　　　　　　 MsgBox shp.Object.Value
> >　>　　　　　　 End If
> >　>　　　　　Next
> >　>　　　 End With
> >　>End Sub
> >　>
>
>YHさんへ。
>
>MsgBox shp.Object.Value
>のかわりに
>k = k + 1
> Cells(k,1).Value = shp.Object.Value
>とでもすればいいんじゃないのかなあ。
>
>-----
>>彷徨い続けて、ここへ流れてきました。
>どのあたりを彷徨ったのですか？
>ここは、場末の行き止まりなのかな？
>なぜここに？
>
>さておき。
>なぜこれほど古いものにコメントをつけるのですか？
> 意味もなく昔のものを掘り出すのは、やめたほうがいいですね。
>
>スレッドには、それぞれテーマが決まっているのですから、
> 別人が勝手に違う話を紛れ込ませるのはマナー違反です。
>
>あなたが新しい質問を建てて、
> 単にコードだけコピーペイストしたらいいじゃありませんか。
> 以前の議論を参照しないといけないことでもないでしょ？
> 仮にそうであったら、リンク先を書けばいいだけです。
>
>>例えば、セルA１から下へ、貼り付けていくのにはどうすればよいでしょうか？
>書込先を移動していくという一般的な話なら、
>なにも古い記事を持ち出す必要もないはず。
>どのような経緯で、この古い記事に行き当たったのですかね。
>
> 以前の投稿者が、なんらかの理由で掘り起こしでもしているのか。
>いずれにしても奇矯な行動に映るので、普通は誰も敬遠してしまうよ。
> （私は変わり者なんでコメントしたけどね）
>
> 続けて質問がもしあるなら、
>そして、削除のためのパスワードが設定してあったらという前提だが、
>あなたの発言を削除して、新しいものを建てたほうが良いと思う。
> 私も、あえて一つ前のものにコメントし、削除できるようにしておく。

・ツリー全体表示


	【77842】Re:貼り付けたHTMLのテキストを取得したい

γ - 16/1/9(土) 18:10 -


	引用なし

	パスワード

> 皆様、はじめまして。彷徨い続けて、ここへ流れてきました。
> こういう場所への投稿は初めてですので、失礼があったらお許しください。
> 本題へ入ります。
> 下記のマクロですが、MsgBoxに表示させるのではなく、
> 例えば、セルA１から下へ、貼り付けていくのにはどうすればよいでしょうか？
> 初心者で大変困っております。
> どうぞよろしくお願いします。
>
> >'=======================================================
>　>Sub testtest()
>　>　　Dim shp As OLEObject
>　>　　With ActiveSheet
>　>　　　 For Each shp In .OLEObjects
>　>　　　　　If UCase(TypeName(shp.Object)) = UCase("htmltext") Or UCase(TypeName(shp.Object)) = UCase("htmltextarea") Then
>　>　　　　　　 MsgBox shp.Object.Value
>　>　　　　　　 End If
>　>　　　　　Next
>　>　　　 End With
>　>End Sub
>　>

YHさんへ。

MsgBox shp.Object.Value
のかわりに
k = k + 1
Cells(k,1).Value = shp.Object.Value
とでもすればいいんじゃないのかなあ。

-----
>彷徨い続けて、ここへ流れてきました。
どのあたりを彷徨ったのですか？
ここは、場末の行き止まりなのかな？
なぜここに？

さておき。
なぜこれほど古いものにコメントをつけるのですか？
意味もなく昔のものを掘り出すのは、やめたほうがいいですね。

スレッドには、それぞれテーマが決まっているのですから、
別人が勝手に違う話を紛れ込ませるのはマナー違反です。

あなたが新しい質問を建てて、
単にコードだけコピーペイストしたらいいじゃありませんか。
以前の議論を参照しないといけないことでもないでしょ？
仮にそうであったら、リンク先を書けばいいだけです。

>例えば、セルA１から下へ、貼り付けていくのにはどうすればよいでしょうか？
書込先を移動していくという一般的な話なら、
なにも古い記事を持ち出す必要もないはず。
どのような経緯で、この古い記事に行き当たったのですかね。

以前の投稿者が、なんらかの理由で掘り起こしでもしているのか。
いずれにしても奇矯な行動に映るので、普通は誰も敬遠してしまうよ。
（私は変わり者なんでコメントしたけどね）

続けて質問がもしあるなら、
そして、削除のためのパスワードが設定してあったらという前提だが、
あなたの発言を削除して、新しいものを建てたほうが良いと思う。
私も、あえて一つ前のものにコメントし、削除できるようにしておく。

・ツリー全体表示


	【77841】Re:excel2003で作ったVBAの誤作動？バグ...

β - 16/1/9(土) 17:26 -


	引用なし

	パスワード

▼たろうさん：

回答ではありません。
状況報告のみ。

こちらの xl2013 で　xlsブックを作成し
標準モジュールにそちらのコードをそのまま貼り付け。
ユーザーフォームモジュールに

Private Sub CommandButton1_Click()
　　Sheet2に記入
End Sub

こんなコードを書いて、ユーザーフォームを表示し、CommandButton1 をクリックしましたが
何回もブック閉じて開いて、やりなおしても何の問題も発生せず、常に Sheet2 のスクロールは正常ですし
もちろん、それにつられて Sheet1 がスクロールするということはおこりません。
また、Sheet1 への入力も、問題なく可能ですし、スクロールもできます。

・ツリー全体表示


	【77839】excel2003で作ったVBAの誤作動？バグ？を...

たろう - 16/1/9(土) 16:03 -


	引用なし

	パスワード

最近サポート終了に伴い社内のExcelが2003から2013に変わりました。
古いExcelで作ったマクロが動かないとまでは行かないですが、どうもおかしな動作が起きたり、突然強制終了されてまた最初からやる羽目になったりして困っています。
それを何とか解消したいと思っています。解決策がわかる方が居りましたら教えてください。ちなみにxls形式、xlsm形式どちらでも同様の症状が出ます。

症状
ユーザーフォームのボタンからSheet1とSheet2を並べて表示させるマクロなんですが特にエラーなどは起きず動作は完了します。内容は以下です。

Sub Sheet2に記入()
'
' Sheet2に記入 Macro
'
　　Application.ScreenUpdating = False
　　Unload UserForm1　　　　　　　　　
　　
　　Sheets("Sheet1").Select
　　ActiveWindow.NewWindow
　　Windows.Arrange ArrangeStyle:=xlArrangeStyleVertical, ActiveWorkbook:=True
　　Sheets("Sheet2").Select
　　Range("B40").Select
　　
　　Application.ScreenUpdating = True
End Sub

この後、Sheet2にSheet1を見ながら入力していくのですが、その時のシートの状態がおかしくなります。アクティブになっているSheet2のセルの選択、入力はできますが、縦スクロールをしようとしたらSheet1がスクロールしてしまう。その時Sheet1はアクティブにできない。といった症状になります。
セルに何か入力する、又は一度Sheet2から別のシートを選ぶと症状は解消されます。
ただ、解消させようとしている途中で強制終了になることがたまにあります。

自分でいろいろ解決策を探ってみたのですが、ユーザーフォームが絡むと起きるようだということまでしかわかりませんでした。

・ツリー全体表示


	【77838】Re:日本語入力システムについて

γ - 16/1/9(土) 13:27 -


	引用なし

	パスワード

▼みみこさん：
>すみませんが、教えてください。
>セルをクリックした時に日本語入力システムがオンになるような設定をしたかったのですが、「データの入力規則」の中に日本語入力システムがありません。
>どのようにしたらいいか、教えてください。

使用しているExcelは英語版ですか？
それなら妥当なことでしょう。
使い方が無理ということなので、日本語版を使ってください。

日本語版ですか？versionは？
入力規則のタブの一番右に「日本語入力」というのが普通はあるんですがね。

・ツリー全体表示


	【77837】日本語入力システムについて

みみこ

- 16/1/9(土) 11:28 -


	引用なし

	パスワード

すみませんが、教えてください。
セルをクリックした時に日本語入力システムがオンになるような設定をしたかったのですが、「データの入力規則」の中に日本語入力システムがありません。
どのようにしたらいいか、教えてください。

・ツリー全体表示


	【77836】Re:貼り付けたHTMLのテキストを取得したい

YH - 16/1/8(金) 23:11 -


	引用なし

	パスワード

皆様、はじめまして。彷徨い続けて、ここへ流れてきました。
こういう場所への投稿は初めてですので、失礼があったらお許しください。
本題へ入ります。
下記のマクロですが、MsgBoxに表示させるのではなく、
例えば、セルA１から下へ、貼り付けていくのにはどうすればよいでしょうか？
初心者で大変困っております。
どうぞよろしくお願いします。

>'=======================================================
>Sub testtest()
>　　Dim shp As OLEObject
>　　With ActiveSheet
>　　　 For Each shp In .OLEObjects
>　　　　　If UCase(TypeName(shp.Object)) = UCase("htmltext") Or UCase(TypeName(shp.Object)) = UCase("htmltextarea") Then
>　　　　　　 MsgBox shp.Object.Value
>　　　　　　 End If
>　　　　　Next
>　　　 End With
>End Sub
>
>

・ツリー全体表示


	【77835】Re:セル内の特定の文字列に囲まれた文字...

凛 - 16/1/8(金) 19:18 -


	引用なし

	パスワード

ウッシ様

ありがとうございます。
上手くできました。

構文を勉強させていただきます。

本当にありがとうございました。

凛

・ツリー全体表示


	【77834】Re:セル内の特定の文字列に囲まれた文字...

ウッシ - 16/1/8(金) 18:49 -


	引用なし

	パスワード

こんばんは

コピペで修正している部分を直すの忘れてました。

Sub test()
　　Dim r As Range
　　Dim s As Long
　　Dim u As Long
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim p As String
　　Dim t As String
　　Dim s1 As Long
　　Dim u1 As Long
　　Dim v1()
　
　　'A列とB列のデータ範囲を選択して実行
　
　　For Each r In Selection
　　　　t = ""
　　　　i = 1: j = 0
　　　　ReDim v1(1 To 2, 1 To 1)
　　　　Do Until i > Len(r)
　　　　　　p = Mid(r, i, Len(r))
　　　　　　s = InStr(1, p, "<sub>")
　　　　　　u = InStr(1, p, "<sup>")
　　　　　　s1 = InStr(1, p, "</sub>")
　　　　　　u1 = InStr(1, p, "</sup>")
　　　　　　If s = 1 Or u = 1 Then
　　　　　　　　j = j + 1
　　　　　　　　ReDim Preserve v1(1 To 2, 1 To j)
　　　　　　End If
　　　　　　If s = 1 Then
　　　　　　　　If s1 - s = 6 Then
　　　　　　　　　　v1(1, j) = Len(t) + 1
　　　　　　　　　　i = i + 5
　　　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　　　Else
　　　　　　　　　　i = i + 5
　　　　　　　　　　For k = 0 To s1 - s - 6
　　　　　　　　　　　　ReDim Preserve v1(1 To 2, 1 To j)
　　　　　　　　　　　　v1(1, j) = Len(t) + 1
　　　　　　　　　　　　t = t & Mid(r, i + k, 1)
　　　　　　　　　　　　j = j + 1
　　　　　　　　　　Next
　　　　　　　　　　i = i + k - 1
　　　　　　　　End If
　　　　　　ElseIf u = 1 Then
　　　　　　　　If u1 - u = 6 Then
　　　　　　　　　　v1(2, j) = Len(t) + 1
　　　　　　　　　　i = i + 5
　　　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　　　Else
　　　　　　　　　　i = i + 5
　　　　　　　　　　For k = 0 To u1 - u - 6
　　　　　　　　　　　　ReDim Preserve v1(1 To 2, 1 To j)
　　　　　　　　　　　　v1(2, j) = Len(t) + 1
　　　　　　　　　　　　t = t & Mid(r, i + k, 1)
　　　　　　　　　　　　j = j + 1
　　　　　　　　　　Next
　　　　　　　　　　i = i + k - 1
　　　　　　　　End If
　　　　　　ElseIf s1 = 1 Then
　　　　　　　　i = i + 6
　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　ElseIf u1 = 1 Then
　　　　　　　　i = i + 6
　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　Else
　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　End If
　　　　　　i = i + 1
　　　　　　s = 0
　　　　　　u = 0
　　　　　　s1 = 0
　　　　　　u1 = 0
　　　　Loop
　　　　r.Value = t
　　　　For i = 1 To UBound(v1, 2)
　　　　　　If v1(1, i) <> "" Then
　　　　　　　　r.Characters(Start:=v1(1, i), Length:=1).Font.Subscript = True
　　　　　　ElseIf v1(2, i) <> "" Then
　　　　　　　　r.Characters(Start:=v1(2, i), Length:=1).Font.Superscript = True
　　　　　　End If
　　　　Next
　　　　r.WrapText = False
　　Next
End Sub

・ツリー全体表示


	【77833】Re:セル内の特定の文字列に囲まれた文字...

凛 - 16/1/8(金) 18:33 -


	引用なし

	パスワード

ウッシ様

お世話になっております。
ご確認及びご教示頂き誠にありがとうございます。

教えて頂きましたVBAを実行したところ、
上付き「<sup>・・・</sup>」対象文字列が下付き
表示になってしまうのですが、
どうしたらよろしいでしょうか？

大変恐縮ですが、ご確認のほどよろしくお願いいたします。

・ツリー全体表示


	【77832】Re:セル内の特定の文字列に囲まれた文字...

ウッシ - 16/1/8(金) 17:20 -


	引用なし

	パスワード

こんにちは

<sup>・・・</sup>
<sub>・・・</sub>
が必ず対になっているとして、

Sub test()
　　Dim r　As Range
　　Dim s　As Long
　　Dim u　As Long
　　Dim i　As Long
　　Dim j　As Long
　　Dim k　As Long
　　Dim p　As String
　　Dim t　As String
　　Dim s1 As Long
　　Dim u1 As Long
　　Dim v1()
　　
　　'A列とB列のデータ範囲を選択して実行
　　
　　For Each r In Selection
　　　　t = ""
　　　　i = 1: j = 0
　　　　ReDim v1(1 To 2, 1 To 1)
　　　　Do Until i > Len(r)
　　　　　　p = Mid(r, i, Len(r))
　　　　　　s = InStr(1, p, "<sub>")
　　　　　　u = InStr(1, p, "<sup>")
　　　　　　s1 = InStr(1, p, "</sub>")
　　　　　　u1 = InStr(1, p, "</sup>")
　　　　　　If s = 1 Or u = 1 Then
　　　　　　　　j = j + 1
　　　　　　　　ReDim Preserve v1(1 To 2, 1 To j)
　　　　　　End If
　　　　　　If s = 1 Then
　　　　　　　　If s1 - s = 6 Then
　　　　　　　　　　v1(1, j) = Len(t) + 1
　　　　　　　　　　i = i + 5
　　　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　　　Else
　　　　　　　　　　i = i + 5
　　　　　　　　　　For k = 0 To s1 - s - 6
　　　　　　　　　　　　ReDim Preserve v1(1 To 2, 1 To j)
　　　　　　　　　　　　v1(1, j) = Len(t) + 1
　　　　　　　　　　　　t = t & Mid(r, i + k, 1)
　　　　　　　　　　　　j = j + 1
　　　　　　　　　　Next
　　　　　　　　　　i = i + k - 1
　　　　　　　　End If
　　　　　　ElseIf u = 1 Then
　　　　　　　　If u1 - u = 6 Then
　　　　　　　　　　v1(1, j) = Len(t) + 1
　　　　　　　　　　i = i + 5
　　　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　　　Else
　　　　　　　　　　i = i + 5
　　　　　　　　　　For k = 0 To u1 - u - 6
　　　　　　　　　　　　ReDim Preserve v1(1 To 2, 1 To j)
　　　　　　　　　　　　v1(1, j) = Len(t) + 1
　　　　　　　　　　　　t = t & Mid(r, i + k, 1)
　　　　　　　　　　　　j = j + 1
　　　　　　　　　　Next
　　　　　　　　　　i = i + k - 1
　　　　　　　　End If
　　　　　　ElseIf s1 = 1 Then
　　　　　　　　i = i + 6
　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　ElseIf u1 = 1 Then
　　　　　　　　i = i + 6
　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　Else
　　　　　　　　t = t & Mid(r, i, 1)
　　　　　　End If
　　　　　　i = i + 1
　　　　　　s = 0
　　　　　　u = 0
　　　　　　s1 = 0
　　　　　　u1 = 0
　　　　Loop
　　　　r.Value = t
　　　　For i = 1 To UBound(v1, 2)
　　　　　　If v1(1, i) <> "" Then
　　　　　　　　r.Characters(Start:=v1(1, i), Length:=1).Font.Subscript = True
　　　　　　ElseIf v1(2, i) <> "" Then
　　　　　　　　r.Characters(Start:=v1(2, i), Length:=1).Font.Superscript = True
　　　　　　End If
　　　　Next
　　　　r.WrapText = False
　　Next
End Sub

で、うまく行くでしょうか？

・ツリー全体表示


	【77831】セル内の特定の文字列に囲まれた文字を上...

凛 - 16/1/8(金) 14:58 -


	引用なし

	パスワード

VBA初心者です。何卒ご教示頂きたくよろしくお願いいたします。

セル内の特定の文字列に囲まれた文字を
・上付き
・下付き
にそれぞれ置換したいです。

＜セル内の特定の文字列に囲まれた文字＞
上付き：　<sup>・・・</sup>（<sup>と</sup>に囲まれた文字列）
下付き：　<sub>・・・</sub>（<sub>と</sub>に囲まれた文字列）

例えば

　 A列
1　ああああああH<sub>2</sub>OいいいいCl<sup>-</sup>ううO<sub>2</sub>えええ。
2　上上上上10cm<sup>3</sup>下下下下下N<sub>2</sub>上上上上。
3　・
4　・
5　・
6　・
7　・

を

　 A列
1　ああああああH2OいいいいCl-ううO2えええ。
※「2」が下付き、「-」が上付き

2　上上上上10cm3下下下下下N2上上上上。
※「2」が下付き、「3」が上付き

という風に変換させたいです。
（1つのセル内に複数存在する場合もあります。）

その他
・上記置換処理をA列とB列の複数列で実行させたいです。

何卒ご教授のほどよろしくお願いいたします。

・ツリー全体表示


	【77830】Re:msgboxでシートを指定する方法

ゆうすけ - 16/1/7(木) 22:41 -


	引用なし

	パスワード

βさん、返信が遅くなり申し訳ありません。
教えていただいた方法で考えていたものにすることができました。
ありがとうございました。

・ツリー全体表示


	【77829】Re:メモリ不足の解消の仕方

YUKI - 16/1/7(木) 15:24 -


	引用なし

	パスワード

▼β 様
お返事遅くなりまして申し訳ありません。
書いていただいたコードを動作させて見た所、
思い描くとおりの結果になりました。
処理もものすごく早くなりました。ありがとうございます！

まだまだ勉強しながらの手探りから脱却できませんが
教えていただいた事を少しづつ理解できるように努力します。
ありがとうございました

・ツリー全体表示


	【77828】Re:メモリ不足の解消の仕方

β - 16/1/6(水) 20:59 -


	引用なし

	パスワード

▼YUKI さん：

とにかく、コメントしている通りよくわかりませんが、だめもとで。
"5" と "6" の転記先がわからないので適当にしておきました。

Sub 貼り付け()
　　Dim i As Integer
　　Dim shF As Worksheet
'
'
'
　　Application.ScreenUpdating = False
　　
'　　On Error Resume Next　 '何のためのコードですか？？

　　For i = 16 To 30

　　　　With Sheets(i)
　　　　　　Set shF = Sheets(i - 15)
　　　　　　.AutoFilterMode = False
　　　　　　.Range("A1", .UsedRange).Offset(40).AutoFilter
　　　　　　'3
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="3"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("A35")
　　　　　　End If
　　　　　　
　　　　　　'4
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="4"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("Q35")
　　　　　　End If
　　　　　　'5
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="5"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("AG35")
　　　　　　End If
　　　　　　'6
　　　　　　.AutoFilter.Range.AutoFilter Field:=8, Criteria1:="6"
　　　　　　If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
　　　　　　　　.AutoFilter.Range.Copy shF.Range("AW35")
　　　　　　End If
　　　　　　.AutoFilterMode = False
　　　　End With
　　　　
　　　　DoEvents
　　Next
　　'
　　'
'　　Erase DynamicArray
　　Sheets(16).Select
　　Application.ScreenUpdating = True

End Sub

・ツリー全体表示


	【77827】Re:メモリ不足の解消の仕方

β - 16/1/6(水) 19:36 -


	引用なし

	パスワード

▼YUKI さん：

コードの記述スタイルは、改善の余地が多々ありますが、いったん、それはさておき。

シートの41行目がタイトル行で、42行目からデータ。
H列で、フィルタリングして、それを別シートのしかるべき場所に転記ということのようですが
"3"および"4"のフィルタリング結果は転記してますけど、"5" と "6" についてはフィルタリングして
コピーはしているものの、どこにもペーストしていませんね。
その理由は？

で、本題のメモリーオーバ。
これぐらいでメモリーオーバーはしないとは思いますが、コピー・ペースト（あるいはコピーのみ）を
繰り返していますね。でも、コピーモードの解除はしていませんので、どんどんクリップボードにため込まれる？
そのあたりが原因かもしれません。

Paste:=xlPasteValues　で値貼り付けをしているようですけど、フルコピー（いわゆるコピペ）では具合悪いですか？

ところで、このシートのレイアウト、正確なところを教えていただけませんか。
特に何列目まであるのかという部分。

・ツリー全体表示


	【77826】Re:メモリ不足の解消の仕方

β - 16/1/6(水) 19:18 -


	引用なし

	パスワード

▼YUKI さん：

コードはまだ読んでいないのですが、DynamicArray って何ですか？
どこにも登場しないんですが。

それと、コードの不具合を追いかける場合（だけではないですが）
きちんとインデントをつけてコードを記述する習慣をつけることを強く推奨します。

あと、使用している変数も、すべて宣言しましょう。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

230 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free