エクセルの学校：全文検索：Hyper Estraier：平均平日

Results of 1 - 1 of about 28 for 平均平日 (0.001 sec.)

平均 (1366), 平日 (459)

[[20100920215412]]: #score: 10343; @digest: e965114eabe8840368815e140c2e938a; @id: 51413; @mdate: 2010-09-21T12:54:23Z; @size: 9345; @type: text/plain; #keywords: 魚" (19771), 週分 (16462), 週目 (15882), 入品 (14460), 菜" (14171), 菜大 (10268), 野菜 (10097), 物" (9830), sachi (7971), 用配 (6949), 果物 (6653), mydic (6417), 月曜 (6022), 大根 (5403), c0 (5380), kanabun (5334), ans (5053), 日[ (4603), 種別 (4565), isempty (4007), 曜日 (3496), 日曜 (3331), 購入 (3274), 目) (2872), 力用 (2567), ト2 (1685), 列〜 (1538), offset (1506), dic (1340), ブラ (1204), worksheets (1200), dictionary (1154); 『重複なしデータを1ヶ月分抽出したい』（sachi）
度々お世話になります。以前こちらで教えて頂いたDictionaryを使って重複なしのデータを抽出しようと思ったのですが、応用がきかず途中で行き詰ってしまいました。どなたか教えて下さい。よろしくお願い致します。シート1 ↓結合セル [G] [H] [I,J] [K,L] [M:Q] [AC][AD][AE,AF][AG,AH][AI:AM]… [7] 種別購入品種別購入品 [8] 果物バナナ野菜大根 [9] 果物桃魚さんま [10] 野菜にんじん野菜ねぎ [11] 魚鮭果物りんご [12] 野菜にんじん野菜大根 [13] 果物桃 [14] [15] [16] [17] シート2 [B] [C] [D] [2] 果物野菜魚 [3] バナナ,桃にんじん鮭 [4] りんご大根,ねぎさんま上記のようにシート1の種別と購入品をキーに重複なしのデータを1日分ずつ抽出してシート2に種別ごとに文字列を結合して転記したい。データは11列おきに月曜から始まって日曜まで、3行おきに10行分の欄が5週分設けてあります。日によって購入件数は違います。とりあえず1週分のデータを抽出してみようと思ったのですが、下記のコードだと 1週分のデータから重複を削除してしまうため、1日ずつのデータが抽出できません。それから翌週以降のデータの抽出と文字列の結合をさせるためのコードがわからず、困っています。（文字列の結合は出来たらでいいです）中途半端で申し訳ありませんが、よろしくお願いします。 Sub test() Dim MyDic(1 To 3) As Object Dim i As Long, j As Long Dim buf As String, Keys Dim tbl As Variant For i = 1 To 3 Set MyDic(i) = CreateObject("Scripting.Dictionary") Next i For i = 7 To 149 Step 11 With Worksheets("シート1") tbl = .Range(.Cells(8, i), .Cells(17, i + 6)).Value End With For j = 1 To UBound(tbl) buf = tbl(j, 1) & vbTab & tbl(j, 7) Select Case tbl(j, 1) Case "果物" If Not MyDic(1).Exists(buf) Then MyDic(1).Add buf, Application.Index(tbl, j, 7) End If Case "野菜" If Not MyDic(2).Exists(buf) Then MyDic(2).Add buf, Application.Index(tbl, j, 7) End If Case "魚" If Not MyDic(3).Exists(buf) Then MyDic(3).Add buf, Application.Index(tbl, j, 7) End If End Select Next j Next i If MyDic(1).Count > 0 Then With Worksheets("シート2") .Range("B3").Resize(MyDic(1).Count, 1).Value = Application.Transpose(MyDic(1).Items) End With End If If MyDic(2).Count > 0 Then With Worksheets("シート2") .Range("C3").Resize(MyDic(2).Count, 1).Value = Application.Transpose(MyDic(2).Items) End With End If If MyDic(3).Count > 0 Then With Worksheets("シート2") .Range("D3").Resize(MyDic(3).Count, 1).Value = Application.Transpose(MyDic(3).Items) End With End If End Sub Excel2000 Windows ---- こんばんは >データは11列おきに月曜から始まって日曜までということで、 [G]列〜月曜日 [R]列〜火曜日 [AC]列〜水曜日 [AN]列〜木曜日 [AY]列〜金曜日 [BJ]列〜土曜日 [BU]列〜日曜日と想定し、 (↑ 11列づつでないときは Set c = c.Offset(, 11) のところの修正が必要です) > とりあえず1週分のデータを抽出してみました。 Sub Try_1週分() Dim ans() As String Dim v Dim i As Long, j As Long, m As Long Dim dic As Object Set dic = CreateObject("Scripting.Dictionary") Dim c As Range ReDim ans(0 To 7, 1 To 3) dic("果物") = 1 dic("野菜") = 2 dic("魚") = 3 ans(0, 1) = "果物" ans(0, 2) = "野菜" ans(0, 3) = "魚" Set c = Worksheets(1).[G7] For m = 1 To 7 '月曜から日曜まで v = c.Offset(1).Resize(10, 7).Value For i = 1 To 10 '上から下へ If IsEmpty(v(i, 1)) Then Exit For '種別データが空白なら、この日のデータ終了 j = dic(v(i, 1)) If Len(ans(m, j)) Then If InStr(ans(m, j), v(i, 7)) = 0 Then ' まだ購入品記載なかったら、 ans(m, j) = ans(m, j) & "," & v(i, 7)' 追加する End If Else ans(m, j) = v(i, 7) End If Next Set c = c.Offset(, 11) Next Set dic = Nothing Worksheets(2).Range("B2").Resize(8, 3).Value = ans 'シート2に書き出す End Sub (kanabun) ---- あと、 >3行おきに10行分の欄が5週分ということですけど、列見出しも考慮すると、最初の見出し行が 7行目のとき次の週は 21行目ということですかね? （下の例はそう考えて Offset(14) しています） Sub Try2_5週分() Dim ans() As String Dim v Dim i As Long, j As Long, m As Long, n As Long, k As Long Dim dic As Object Set dic = CreateObject("Scripting.Dictionary") Dim c0 As Range, c As Range ReDim ans(0 To 35, 1 To 3) dic("果物") = 1 dic("野菜") = 2 dic("魚") = 3 ans(0, 1) = "果物" ans(0, 2) = "野菜" ans(0, 3) = "魚" Set c0 = Worksheets(1).[G7] Set c = c0 For n = 1 To 5 '1週目から 5週目まで For m = 1 To 7 '月曜日から日曜日まで If IsEmpty(c.Offset(1)) Then Exit For k = (n - 1) * 7 + m v = c.Offset(1).Resize(10, 7).Value For i = 1 To 10 If IsEmpty(v(i, 1)) Then Exit For j = dic(v(i, 1)) If Len(ans(k, j)) Then If InStr(ans(k, j), v(i, 7)) = 0 Then ans(k, j) = ans(k, j) & "," & v(i, 7) End If Else ans(k, j) = v(i, 7) End If Next If m = 7 Then Set c0 = c0.Offset(14) Set c = c0 Else Set c = c.Offset(, 11) End If Next m Next n Set dic = Nothing With Worksheets(2) .Columns("B:D").ClearContents .Range("B2").Resize(k + 1, 3).Value = ans End With End Sub (kanabun) ---- kanabun様回答ありがとうございました。列の11行おきというのはM列からのカウントでした。G列からだと22行おきになるので、ご指示通り修正したらうまくいきました。行については2週目は21行目が見出し行であっています。説明不足ですみません。上記のコードで試してみたところ、1週目の土日がブランクの状態で、 2週目の月曜以降に種別と購入品が入力されている場合、1週目の金曜分までしかシート2に表示されませんでした。土日も入力するとそれ以降も表示されましたが、次にまたブランクの日があるとその前日までしか表示されません。ブランクの日の分はシート2の行を空けて、それ以降をまた表示させるにはどうしたらいいでしょうか? それから現在、上記のコードを勉強中なのですが、k = (n - 1) * 7 + mのところの意味を教えて頂けないでしょうか? 質問ばかりですみませんが、よろしくお願い致します。 (sachi) ---- こんばんは > ブランクの日の分はシート2の行を空けて、それ以降をまた表示させるには > どうしたらいいでしょうか? > If IsEmpty(c.Offset(1)) Then Exit For のところを Exit For するのでなく、以下のように If 空白でなかったら Then 処理 End If のようにすれば、お望みの出力になるかと思います。 Set c0 = Worksheets(1).[G7] Set c = c0 For n = 1 To 5 '1週目から 5週目まで For m = 1 To 7 '月曜日から日曜日まで 'If IsEmpty(c.Offset(1)) Then Exit For If Not IsEmpty(c.Offset(1)) Then '◆変更 k = (n - 1) * 7 + m v = c.Offset(1).Resize(10, 7).Value For i = 1 To 10 If IsEmpty(v(i, 1)) Then Exit For j = dic(v(i, 1)) If Len(ans(k, j)) Then If InStr(ans(k, j), v(i, 7)) = 0 Then ans(k, j) = ans(k, j) & "," & v(i, 7) End If Else ans(k, j) = v(i, 7) End If Next End If '◆追加 If m = 7 Then Set c0 = c0.Offset(14) Set c = c0 Else Set c = c.Offset(, 11) End If Next m Next n > 上記のコードを勉強中なのですが、k = (n - 1) * 7 + mのところの意味を > 教えて頂けないでしょうか? その式は、 For n = 1 To 5 '1週目から 5週目まで For m = 1 To 7 '月曜日から日曜日までですから、たとえば (k = ) n = 1 (1週目) m = 1 (月曜日) のとき、上の式は (1 - 1) *7 + m で出力用配列の 1行目 n = 2 (2週目) m = 1 (月曜日) のとき、上の式は (2 - 1) *7 + 1 で出力用配列の 8行目 n = 5 (5週目) m = 1 (月曜日) のとき、上の式は (5 - 1) *7 + 1 で出力用配列の 29行目と、出力用配列(35行+ヘッダ行 = 36行用意してあります) の書き込む行番号を計算しているところです。 (kanabun) ---- kanabun様早速のご回答ありがとうございました! 明朝、会社で試してみます。丁寧な説明もありがとうございました、大変助かりました。 (sachi) ...; http://www.excel.studio-kazu.jp/wiki/kazuwiki/201009/20100920215412.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ