Excel VBA質問箱 IV

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

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


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

235 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77742】Re:特定条件の行に他シートの行を貼り付...

γ - 15/12/13(日) 8:54 -


	引用なし

	パスワード

これから出掛けてしまうので、時間がとれませんがコメント追加しておきます。オートフィルタだけを使って操作するには以下のようにします。「項目」をキーワードにしてオートフィルタを掛けた段階で A列の可視セルを変数にセットしておきます。・オートフィルタを解除します。・For each で以下の操作を繰り返します。・その行に見出しをコピーペイストします。・そのセルのCurrentRegionをとれば、そのブロックだけが選択できます。　それをシートにコピーペイストしてください。・シート名にすべき文字列は、そのセルのOffset(-1)に入っていますから、　シー名を修正します。こんな方針でいかがでしょうか。

・ツリー全体表示


	【77741】Re:特定条件の行に他シートの行を貼り付...

γ - 15/12/12(土) 22:40 -


	引用なし

	パスワード

最終行は下記のようにして求めることができます。
　　Dim lastRow As Long
　　lastRow = Cells(Rows.Count, 1).End(xlUp).Row

フィルタで抽出した段階で、
2行目からlastRowを対象にして貼付けると
可視セルだけに貼り付けることができます。

後半部分は、下記のコードを参考にしてください。
一行空白行がありますから、そこに注目して、Areasを活用します。

Sub test()
　　Dim lastRow As Long
　　Dim area As Range
　　Dim myRng As Range
　　
　　lastRow = Cells(Rows.Count, 1).End(xlUp).Row
　　
　　Set myRng = Range("A1", Cells(lastRow, 1)).SpecialCells(xlCellTypeConstants)
　　
　　For Each area In myRng.Areas
　　　　Set r = area.Resize(, 4)
　　　　
　　　　Debug.Print r.Address　　　　　 '確認用
　　　　
　　　　' r を　新しいブックのシートにコピー。
　　　　' シート名は　r(1).Valueに変更
　　Next
End Sub

・ツリー全体表示


	【77740】Re:特定条件の行に他シートの行を貼り付...

さいとう - 15/12/12(土) 22:21 -


	引用なし

	パスワード

▼γ さん：
レスありがとうございます。

マクロの記録を使い、
sheet1でオートフィルタを用いてA列が「項目」の行を抽出して
「見出し」シートの2行目を貼り付けしようとしたところ、

Sub midashi_
　　Sheets("Sheet1").Select
　　Range("A1:D18").Select　←末行18としていますが実際の行数は変動します。
　　Selection.AutoFilter
　　Selection.AutoFilter Field:=1, Criteria1:="項目"
　　Sheets("見出し").Select
　　Rows("1:1").Select
　　Selection.Copy
　　Sheets("sheet1").Select
　　Rows("7:13").Select
　　ActiveSheet.Paste
End Sub

となって貼り付け行がRows("7:13")で固定されてしまい変動に対応しません。
また、オートフィルタで抽出した行になんとか貼れないものかと試行錯誤しているうちに、
抽出されない行（非表示になっている部分）にまで全部貼り付けてしまったりもしました。

そして、見出しを未処理のままでsheet1を
　　Workbooks.Add
　　ActiveSheet.Paste
により別のブックにすることはできたのですが、表でシートを分けることができませんでした･･･

・ツリー全体表示


	【77739】Re:特定条件の行に他シートの行を貼り付...

γ - 15/12/12(土) 21:07 -


	引用なし

	パスワード

▼さいとうさん：
>手探りでマクロを勉強しておりますがわからないので質問させていただきます。
いいですね。頑張って下さい。
それで、どこまでできているんでしょうか？
部分的でも構いませんので、できているところまで書いてもらえますか？

・ツリー全体表示


	【77738】特定条件の行に他シートの行を貼り付け＆...

さいとう - 15/12/12(土) 20:17 -


	引用なし

	パスワード

はじめまして。
手探りでマクロを勉強しておりますがわからないので質問させていただきます。
Excel2013です。

やおやＡ　　　　　　　　
項目　みかん　りんご　なし
1日　　5　　　　1　　　2
2日　　1　　　　2　　　3
----空白1行----
やおやＢ　　　　　　　　
項目　みかん　りんご　なし
1日　　2　　　　4　　　5
2日　　5　　　　2　　　1
3日　　4　　　　5　　　3
----空白1行----
やおやＣ　　　　　　　　
項目　みかん　りんご　なし
1日　　4　　　　5　　　2
2日　　1　　　　1　　　3
3日　　2　　　　5　　　3
4日　　1　　　　8　　　6
5日　　3　　　　2　　　1

上記のように、セルA1に「やおやＡ」が入る形で、やおやＡ～Ｃ（増減あり）の表がsheet1に空白行を挟んで縦に並んでいます。
各店舗の表の行数はバラバラで、変動します。

１．同じブック内の別シート（シート名：見出し）の2行目の行を、sheet1の上記表の各「項目」で始まる行に貼り付けたい。（現在の「項目～」で始まる行が不要。差し替えたい）
（「項目」はＡ列、「みかん」はＢ列、「りんご」はＣ列に入っています）

２．１の処理の終わったそれぞれのやおや表を、新規ブックにシート別に貼り付けたい。

３．新規ブックのシート名をやおやの名前にしたい。

以上です。
よろしくお願いいたします。

・ツリー全体表示


	【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

に直してください。

・ツリー全体表示


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

235 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free