Excel VBA質問箱 IV

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

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


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

236 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77737】Re:処理速度の向上

γ - 15/12/12(土) 10:00 -


	引用なし

	パスワード

確かに掛かる時間にばらつきがあることは確認しました。
遅くなる理由を解明するよりも、
> EXCELのセルに入力されている文字の文字色、サイズなどを判別しなくてはいけません。
> Charactersを使用するので処理速度が遅くなるのはしょうがないとあきらめています
という当面の具体的な課題を説明されたらどうですか？
判定するにも効率のよい方法が工夫できるはずです。

・ツリー全体表示


	【77736】Re:文字入力を行ないたい

さとし - 15/12/11(金) 20:06 -


	引用なし

	パスワード

ウッシ様
回答ありがとうございます

解決しました
ありがとうございました
また宜しくお願いします

・ツリー全体表示


	【77735】処理速度の向上

おさむ - 15/12/11(金) 13:24 -


	引用なし

	パスワード

EXCELのセルに入力されている文字の文字色、サイズなどを判別しなくてはいけません。
Charactersを使用するので処理速度が遅くなるのはしょうがないとあきらめています。

ただ、下記のプログラムをブックを開いてすぐに実行する場合と
ブックを開いて何処でもいいからセルの文字を編集してから実行する
のでは処理速度が違います。

前者の処理速度：50秒
後者の処理速度：18秒

この理由が判りません。
この理由をEXCELの仕様だからと無理矢理に納得したとして、この仕様を
利用して処理速度を早くさせる方法はあるのでしょうか？

前提としてA列の1行から1000行までのセルに全て1000文字入力しています。

Private Sub cmdInput_Click()
　　Dim StartTime As Variant
　　Dim StopTime As Variant
　　Dim lCnt As Long
　　Dim lNum As Long
　　
　　StartTime = Time
　　
　　For lNum = 1 To 10000
　　　　For lCnt = 1 To ActiveSheet.Cells(lNum, 1).Characters.Count
　　　　Next
　　Next
　　
　　StopTime = Time
　　StopTime = StopTime - StartTime
　　
　　MsgBox "処理時間：" & Minute(StopTime) & "分" & Second(StopTime) & "秒"
End Sub

例えばこのStartTime = Timeの前にプログラムでセル編集しても遅いままでした。
また、SendKeys "{F2}", TrueをStartTime = Timeの前に記述しても遅いままでした。

宜しくお願い致します。

・ツリー全体表示


	【77734】Re:文字入力を行ないたい

ウッシ - 15/12/11(金) 10:54 -


	引用なし

	パスワード

こんにちは

Sub test()
　　Dim bk1 As Workbook
　　Dim bk2 As Workbook
　　Dim s　 As Worksheet
　　Dim p　 As String
　　Dim d　 As Range
　　
　　p = ThisWorkbook.Path & "\"
　　
　　Application.ScreenUpdating = False
　　
　　Set bk1 = Workbooks.Open(p & "得意先p.xlsx")
　　Set d = bk1.Worksheets("Sheet1").Range("A:A")
　　
　　Set bk2 = Workbooks.Open(p & "フォーマットi.xlsx")
　　
　　For Each s In bk2.Worksheets
　　　　If s.Name = "惣菜" Then
　　　　　　Call test1(d, s, 4, 2, 34)
　　　　Else
　　　　　　Call test1(d, s, 5, 2, 20)
　　　　End If
　　Next
　　
　　Application.ScreenUpdating = True

End Sub
Sub test1(tR As Range, sh2 As Worksheet, t As Long, i As Long, g As Long)
　　Dim v As Variant
　　Dim r As Long
　　Dim o As Long
　　
　　o = i - t
　　With sh2
　　　　For r = t To .Range("T" & Rows.Count).End(xlUp).Row Step g
　　　　　　v = Application.Match(.Range("T" & r), tR, 0)
　　　　　　If IsError(v) = False Then
　　　　　　　　.Range("T" & r).Offset(o, -11).Value = _
　　　　　　　　　　sh2.Name & tR(v, 1).EntireRow.Range("BA1").Value
　　　　　　End If
　　　　Next
　　End With
End Sub

こんな感じでしょうか？

・ツリー全体表示


	【77733】文字入力を行ないたい

さとし - 15/12/11(金) 8:10 -


	引用なし

	パスワード

book1を立ち上げて、得意先pとフォーマットiを立ち上げます EXCEL2010です得意先pのsheet1のA1から最下行（不定）に数字があり、その数字を含む行のBAに文字（新品、代替、返品）がありますフォーマットiには6つのシートがあり、6つのシートのいずれかのT列に、得意先pのA1から最下行（不定）の数字があった時に、I列に文字を入力したく思います（I列は元々空白です）文字はsheet名＋得意先pのBAにある文字（新品、代替、返品）を入れますフォーマットiは、以下のシートで構成されています左側より、漬物、惣菜、スイーツ、カップ麺、見切品、フライです惣菜シートのT列は、T4、T38、T72…と言った形で、34行毎にあります惣菜シートのI列は、I2、I36、I70…と言った形で、34行毎にあります T4とI2が紐づき、T38とI36が紐づき、T72とI70が紐づきます惣菜シート以外のT列は、T5、T25、T45…と言った形で、20行毎にあります惣菜シート以外のI列は、I2、I22、I42…と言った形で、20行毎にあります T5とI2が紐づき、T25とI22が紐づき、T45とI42が紐づきます例えば、得意先pのA1に1000があり、BAに新品とありますフォーマットiの惣菜シートのT38に1000があったら、 I36に惣菜新品と入力します例えば、得意先pのA4に1500があり、BAに変更とありますフォーマットiの漬物シートのT25に1500があったら、 I22に漬物代替と入力します数字の体系でシートを指定しているのではなく、6つのシートのいずれかにありますので6つのシート内を探して、VBAで行ないたく思います book1にコードを実装しますご教授下さい

・ツリー全体表示


	【77732】Re:ＶＢＡで数式のセルをカウントさせな...

勉強不足 - 15/12/6(日) 20:48 -


	引用なし

	パスワード

▼マナさん：

ちょっと自分のものに組み込んでみます。

皆さん、凄い知識と実力をお持ちで感服しております。

早く近づけるように頑張ります。

ありがとうございました。また宜しくお願いいたします。

・ツリー全体表示


	【77731】Re:ＶＢＡで数式のセルをカウントさせな...

マナ - 15/12/6(日) 19:29 -


	引用なし

	パスワード

▼勉強不足さん：

次は、こう回答するつもりでいました。

では、最初のコードで、数式入力しているところを

.Formula = "=if(b4="""","""",row()-3)"

とか。

・ツリー全体表示


	【77730】Re:ＶＢＡで数式のセルをカウントさせな...

勉強不足 - 15/12/6(日) 19:10 -


	引用なし

	パスワード

▼β さん：

凄いです！！
希望通りの動作です。１週間も悩んでいたのが・・・・・
これを参考に、読み説いて更なるレベルアップに努めてゆきます。

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

今現在は、参考書８冊とネットで修行中です・・・

・ツリー全体表示


	【77729】Re:ＶＢＡで数式のセルをカウントさせな...

勉強不足 - 15/12/6(日) 19:03 -


	引用なし

	パスワード

▼マナさん：
>▼勉強不足さん：
>
>B列が数式で""になっているということでしょうか。
>であればA列も数式で""にすればよいのでは？

返信ありがとうございます。
ご指摘の通りなのですが、このシートをさらにＡ1をキーにして引き込むマクロを組み込んであり、結局どこかで数式を読み込まない部分が必要なのです。
=IF(OR(D15="",D15=0),"",B15)
このような数式では読み込まれてしまい、関数でも対応不可能なのです。

もしくは、最終行を読み込んで、それ以降を削除するようなものを作ろうとも考えたのですが、私の能力では出来ませんでした。
だれか助けて下さい。

・ツリー全体表示


	【77728】Re:ＶＢＡで数式のセルをカウントさせな...

β - 15/12/6(日) 19:02 -


	引用なし

	パスワード

▼勉強不足さん：

マナさんの指摘通りだと思いますが、ＶＢＡの処理練習ということなら。
以下はあくまで１つの方法です。

Sub Test()
　　Dim f As Range
　　Set f = Columns("B").Find(What:="*", LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious)
　　With Range("B4", f).Offset(, -1)
　　　　.Formula = "=row()-3"
　　　　.Value = .Value
　　End With
End Sub

・ツリー全体表示


	【77727】Re:縦並びを横並びにしたいです。

さと - 15/12/6(日) 18:53 -


	引用なし

	パスワード

βさん。

ご回答ありがとうございました。

おかげさまで、こちらもうまくいきました。！

γさんのお礼にも書きましたが、βさんの書いたコードも私はスラスラとは読めないので、これからじっくり内容を勉強させていただきます。

本当に感謝いたします。

私事のため、貴重な時間を割いていただき誠にありがとうございました。

・ツリー全体表示


	【77726】Re:ＶＢＡで数式のセルをカウントさせな...

マナ - 15/12/6(日) 18:22 -


	引用なし

	パスワード

▼勉強不足さん：

B列が数式で""になっているということでしょうか。
であればA列も数式で""にすればよいのでは？

・ツリー全体表示


	【77725】Re:縦並びを横並びにしたいです。

さと - 15/12/6(日) 18:18 -


	引用なし

	パスワード

γさん。

早速の回答ありがとうございました。

おかげさまで、うまくいきました！すごいですね。

質問にも書きましたが、私はまだVBAについての知識が浅いので、正直γさんの書いたコードがスラスラとは読めません。。

これからじっくりとγさんの書かれたコードについて内容を勉強していきます。

私も、γさんのようにスラスラとコードが書けるようになりたいです。

ここは素敵な掲示板ですね。

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

・ツリー全体表示


	【77724】ＶＢＡで数式のセルをカウントさせない方...

勉強不足 - 15/12/6(日) 18:00 -


	引用なし

	パスワード

データシートを作成しており、それにナンバリングをさせたいんですが
どうしても文字が入っていない数式の入ったセルも読み込んでしまいます。
それを回避する方法を教えて下さい。

Ｂ４セル以降に文字が入力されており、それを読み込んでＡ４セル以降にナンバリングを行いたいです。しかし、Ｂセルには数式が入力されておりそれは消したくない為に、以上のような回避策が必要です。

Sub ナンバリング()
Dim i As Long
i = Cells(Rows.Count, 2).End(xlUp).Row
With Range(Cells(4, 1), Cells(i, 1))
.Formula = "=row()-3"
.Value = .Value
End With
End Sub '

・ツリー全体表示


	【77723】Re:縦並びを横並びにしたいです。

β - 15/12/6(日) 15:23 -


	引用なし

	パスワード

▼さとさん：

アップしたコードに間違いがありました。

>　　　　　　tmp(1) = tmp(1) + 2
>　　　　　　dic(c.Value) = tmp
>　　　　End If

この tmp(1) = tmp(1) + 2

これを　tmp(1) = tmp(1) + 1

に直してください。

・ツリー全体表示


	【77722】Re:縦並びを横並びにしたいです。

β - 15/12/6(日) 14:39 -


	引用なし

	パスワード

▼さとさん：

二番煎じですが。

Sub Test()
　　Dim dic As Object
　　Dim c As Range
　　Dim w As Variant
　　Dim tmp As Variant
　　Dim mx As Long
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　For Each c In Range("D2", Range("D" & Rows.Count).End(xlUp))
　　　　dic(c.Value) = Array(dic.Count + 1, 0)
　　Next
　　
　　ReDim w(1 To dic.Count, 1 To Columns.Count)
　　
　　For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
　　　　If dic.exists(c.Value) Then
　　　　　　tmp = dic(c.Value)
　　　　　　tmp(1) = tmp(1) + 1
　　　　　　w(tmp(0), tmp(1)) = c.Offset(, 1).Value
　　　　　　w(tmp(0), tmp(1) + 1) = c.Offset(, 2).Value
　　　　　　If tmp(1) + 1 > mx Then mx = tmp(1) + 1
　　　　　　tmp(1) = tmp(1) + 2
　　　　　　dic(c.Value) = tmp
　　　　End If
　　Next
　　
　　ReDim Preserve w(1 To UBound(w, 1), mx)
　　Range("E2").Resize(UBound(w, 1), UBound(w, 2)).Value = w
　　
End Sub

・ツリー全体表示


	【77721】Re:縦並びを横並びにしたいです。

γ - 15/12/6(日) 13:58 -


	引用なし

	パスワード

まず気づくのは、マッチしたあとも比較を続けていること。
マッチして作業が終わったら Exit Forするとそれだけでも 1/2 になります。

ただこのような場合、一つずつ突き合わせをしていくのは効率が悪いです。
Dictionaryというデータ構造を使うと、それに備わった高速の検索機能が活かせて、
もっと早く突き合わせができます。
これを使うと良いと思います。

例えば、こんな書き方です。（未検証なのでまちがっていたら失礼）

Sub yokonarabi2()
　　Dim dic As Object
　　Dim i As Long, ii As Long
　　Dim r As Long
　　Dim saishuA As Long, saishuE As Long
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　'A列(コード)の最終セル
　　saishuA = Cells(Rows.Count, 1).End(xlUp).Row
　　'E列(作業列)の最終セル
　　saishuE = Cells(Rows.Count, 5).End(xlUp).Row
　　
　　For ii = 2 To saishuE
　　　　dic(Cells(ii, 5).Text) = ii
　　Next

　　For i = 2 To saishuA
　　　　r = dic(Cells(i, 1).Text)
　　　　Range(Cells(i, 2), Cells(i, 3)).Copy _
　　　　　 Destination:=Cells(r, Columns.Count).End(xlToLeft).Offset(0, 1)
　　Next
End Sub

・ツリー全体表示


	【77720】縦並びを横並びにしたいです。

さと - 15/12/6(日) 12:50 -


	引用なし

	パスワード

はじめて投稿させていただきます。
仕事で、縦並びの表を横並びにする必要があり、VBAで対応したく思っております。
条件としてA列(コード)に従い、予めE列(作業列)に表示してあるコードの右側に氏名と金額を横並びにしたいのですが、その際、A列のコードが同じものはE列に記載してあるコードの更に右側に(氏名)と(金額)を加えていくというものです。

（表）
A　　　　B　　　　C　　D　　E　　　　 F　　　　G　　　　H　　　　 I　　　J　　　 K
コード　氏名　　金額　　　作業列　 1　　　　2　　　　3　　　　4　　　5　　　 6
1001　　ホンダ 3500　　　1001　　ホンダ　3500　　　　　　　　　　　
1002　　スズキ 5000　　　1002　　スズキ　5000　ヤマハ　6000　　　　　　　　
1002　　ヤマハ 6000　　　1003　　カワサ　5000　カノン　 8000　ペンタ　5000
1003　　カワサ 5000　　　1004　　ナイコ　10000　オリン　10000　　　　　　　　
1003　　カノン　8000　　　1005　　トヨタ　 10000　ニサン　8000　　　　　　　　
1003　　ペンタ 5000
1004　　ナイコ10000　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
1004　　オリン 10000　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
1005　　トヨタ　10000　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
1005　　ニサン 8000　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　

VBAについては初心者で、いろいろ参考にしながら下記のコードを書きました。

----------------------------------------------------------------------
Sub yokonarabi()

Dim i As Long, ii As Long

'A列(コード)の最終セル
saishua = Cells(Rows.Count, 1).End(xlUp).Row
'E列(作業列)の最終セル
saishue = Cells(Rows.Count, 5).End(xlUp).Row

For i = 2 To saishua
　　For ii = 2 To saishue
'コードと作業列の値が同じならば
　　　　If Cells(i, 1).Value = Cells(ii, 5).Value Then
'作業列の右側空白セルに氏名と金額を貼り付け
　　　　Range(Cells(i, 2), Cells(i, 3)).Copy Destination:= _
　　　　　　Cells(ii, Columns.Count).End(xlToLeft).Offset(0, 1)
　　　　Else
　　　　End If
　　Next
Next

End Sub
-----------------------------------------------------------------------

上記コードを実行したところ、うまく動いたのですが、本番で取り扱う表はA列が２万行近くあり、VBAを実行するとエクセルが固まってしまいます。
どのようにすれば、大量の行数にも対応できるようになるでしょうか。

是非、ご教授願います。

・ツリー全体表示


	【77719】Re:ハイパーリンクをつけるマクロについて

γ - 15/12/6(日) 9:08 -


	引用なし

	パスワード

> vbaを勉強中なので、この意味が全くわかりません。 > わかる方、出来るだけ易しく教えてください。よろしくお願いします。回答が示されたのでそちらを参考にして頂ければと思いますが、補足です。 VBAを学習中とのことで、ご苦労さまです。 VBAのコードを書くには、それに対応する一般機能を知っていなければなりません。単純なことですが重要なことです。それを自覚しない方が結構多いです。・どこに、ハイパーリンクを設定するか。・リンク先はどこか。他のファイルなのか、他のサイトなのか、　今使っているブックの特定シートなのか、そのセル範囲は？・リンクを張っているセルに、どんな文字列を表示するのかといった情報を指示する必要があります。リンク先がどんな種類かによって、指定方法が微妙に違います。それらは、ご自分で確認するのが確実です。コードを書くには、すべて、頭からコードが湧いてくる訳でもありません。実際に手を動かして確認しながら進めるものです。そのあたりを誤解されていてはいけないので、補足しておきます。

・ツリー全体表示


	【77718】Re:ハイパーリンクをつけるマクロについて

マナ - 15/12/5(土) 22:34 -


	引用なし

	パスワード

▼こういちさん：

参考コードです。
目次シートのシートモジュールに貼り付けてください。
説明は苦手なので、コードの意味はネット検索等で調べてください。

Sub 他のシートへのハイパーリンク作成()
　　Dim h As Hyperlink
　　Dim ws As Worksheet
　　Dim c As Range
　　Dim n As Long
　　
　　For Each h In Hyperlinks
　　　　h.Range.Clear
　　Next
　
　　For Each ws In Worksheets
　　　　If Not ws Is Me Then
　　　　　　Set c = Range("A3").Offset(n)
　　　　　　Hyperlinks.Add Anchor:=c, Address:="", _
　　　　　　　　SubAddress:=ws.Name & "!A1", TextToDisplay:=ws.Name
　　　　　　n = n + 1
　　　　End If
　　Next

End Sub

・ツリー全体表示


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

236 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free