Results of 1 - 1 of about 48864 for A�����������������������... (0.009 sec.)
- [[20120316201345]]
- #score: 1420
- @digest: 249fb32d82d69549ad1b53d0726e48c1
- @id: 58151
- @mdate: 2012-03-17T08:08:53Z
- @size: 22361
- @type: text/plain
- #keywords: rnglista (88414), rnglistb (78012), lngcolu (77615), rngresultb (64439), rngresulta (64439), lngcompb (61349), vntlistb (60248), lngcountab (59046), rngresultab (58145), dicaonly (57129), dicbonly (57129), lngcompa (51561), clngcolumnsb (51417), clngcolumnsa (50901), lngrowsb (49910), vntlista (48742), lngrowsa (48740), lngkeys (45473), getbasicdata (44364), 葡萄 (41461), 較位 (39393), datacompare (37054), vntkeys2 (27727), strprom (26155), 林檎 (18696), lngrows (18459), rnglist (12417), dica (10465), 号名 (8017), シー (4778), メロ (4564), 比較 (4075)
- 『一致しない物の名前が知りたい』（キュア）
AシートとBシートにある物の名前と番号を抜き出すには? Aシートの番号と名前は重複しません。 Bシートの番号と名前は続く場合もあるし離れて出没することもあります。 Cシートに AシートにあってBシートにないもの BシートにあってAシートにないもの AシートにもBシートにもある件数 以上3点の抜き出し方を教えてください。 Aシート Bシート 番号 名前 番号 名前 11 桃 99 メロン 22 林檎 99 メロン 555 蜜柑 11 桃 33 檸檬 777 葡萄 777 葡萄 777 葡萄 88 西瓜 777 葡萄 22 林檎 777 葡萄 22 林檎 44 パイン AシートにあってBシートにないもの BシートにあってAシートにないもの 555 蜜柑 99 メロン 33 檸檬 44 パイン 88 西瓜 AシートにもBシートにもあるものの件数 （つまり 桃、林檎、葡萄） 3 2007 XP ---- マクロで善ければ? AシートのListは"Sheet1"、BシートのListは"Sheet2"に在り、列見出しが有る物とします 結果は"Sheet3"に出力されます Option Explicit Public Sub DataMatch() 'Aシートのデータ列数（A列〜B列） Const clngColumnsA As Long = 2 'Aシートの比較する列の列位置(基準セル位置からの列Offset:A列) Const clngKeysA As Long = 0 'Bシートのデータ列数（A列〜B列） Const clngColumnsB As Long = 2 'Bシートの比較する列の列位置(基準セル位置からの列Offset:A列) Const clngKeysB As Long = 0 Dim rngListA As Range Dim vntListA As Variant Dim lngRowsA As Long Dim lngCompA As Long Dim rngListB As Range Dim vntListB As Variant Dim lngRowsB As Long Dim lngCompB As Long Dim lngMatch As Long Dim rngResultA As Range Dim rngResultB As Range Dim rngResultAB As Range Dim lngWriteA As Long Dim lngWriteB As Long Dim lngCountAB As Long Dim lngTmp As Long Dim strProm As String 'AシートのA1を基準とします(列見出しが有るとします) '★実際のシート名に変更する事 Set rngListA = Worksheets("Sheet1").Cells(1, "A") 'BシートのA1を基準とする(列見出しが有るとします) '★実際のシート名に変更する事 Set rngListB = Worksheets("Sheet2").Cells(1, "A") '画面更新を停止 Application.ScreenUpdating = False '「結果出力」の位置を指定します '★実際のシート名に変更する事 With Worksheets("Sheet3") Set rngResultA = .Cells(1, "A") Set rngResultB = .Cells(1, "E") Set rngResultAB = .Cells(1, "I") .UsedRange.ClearContents End With 'Aシートの基準に就いて If Not GetBasicData(rngListA, lngRowsA, _ clngColumnsA, clngKeysA, vntListA) Then strProm = rngListA.Value & "にデータが有りません" GoTo Wayout End If 'Bシート基準に就いて If Not GetBasicData(rngListB, lngRowsB, _ clngColumnsB, clngKeysB, vntListB) Then strProm = rngListB.Value & "にデータが有りません" GoTo Wayout End If rngResultA.Value = "Aシートに在って、Bシートに無い物" rngResultB.Value = "Bシートに在って、Aシートに無い物" rngResultAB.Value = "AシートにもBシートにもある物の件数" 'Aシートの比較位置 lngCompA = 1 'Bシートの比較位置 lngCompB = 1 'AシートBシートが共に最終行に達するまで繰り返し Do Until lngCompA > lngRowsA And lngCompB > lngRowsB '各列のデータを比較 lngMatch = DataCompare(vntListA, lngCompA, vntListB, lngCompB) '比較結果に就いて Select Case lngMatch Case Is = 0 'Matchiした場合 '出現をカウント lngCountAB = lngCountAB + 1 Do 'Bシートの比較位置を更新 lngCompB = lngCompB + 1 Loop While vntListA(lngCompA, 1) = vntListB(lngCompB, 1) 'Aシートの比較位置を更新 lngCompA = lngCompA + 1 Case Is = -1 'Aシートの固有値の場合 'データを出力 lngWriteA = lngWriteA + 1 rngResultA.Offset(lngWriteA).Resize(, clngColumnsA).Value _ = rngListA.Offset(lngCompA).Resize(, clngColumnsA).Value 'Aシートのシートの比較位置を更新 lngCompA = lngCompA + 1 Case Is = 1 'Bシートの固有値の場合 'データを出力 lngWriteB = lngWriteB + 1 rngResultB.Offset(lngWriteB).Resize(, clngColumnsB).Value _ = rngListB.Offset(lngCompB).Resize(, clngColumnsB).Value lngTmp = lngCompB Do 'Bシートの比較位置を更新 lngCompB = lngCompB + 1 Loop While vntListB(lngTmp, 1) = vntListB(lngCompB, 1) End Select Loop 'AシートにもBシートにもある物の件数を出力 rngResultAB.Offset(1).Value = lngCountAB With rngListA 'データの順番を元に戻す DataSort .Offset(1).Resize(lngRowsA, clngColumnsA + 1), .Offset(1, clngColumnsA) '復帰用連番を消去 .Offset(1, clngColumnsA).EntireColumn.Clear End With With rngListB 'データの順番を元に戻す DataSort .Offset(1).Resize(lngRowsB, clngColumnsB + 1), .Offset(1, clngColumnsB) '復帰用連番を消去 .Offset(1, clngColumnsB).EntireColumn.Clear End With strProm = "処理が完了しました" Wayout: '画面更新を再開 Application.ScreenUpdating = True Set rngListA = Nothing Set rngListB = Nothing Set rngResultA = Nothing Set rngResultB = Nothing MsgBox strProm, vbInformation End Sub Private Function GetBasicData(rngList As Range, _ lngRows As Long, _ lngColumns As Long, _ lngKeys As Long, _ vntData As Variant) As Boolean '基準に就いて With rngList '行数を取得 lngRows = .Offset(.Parent.Rows.Count - .Row, lngKeys).End(xlUp).Row - .Row 'データが無ければFunctionを抜ける(戻り値=False) If lngRows <= 0 Then Exit Function End If '最終列の後ろに復帰用連番を付与します With .Offset(1, lngColumns) .Value = 1 .Resize(lngRows).DataSeries Rowcol:=xlColumns, _ Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False End With 'データをlngKeys列で整列 DataSort .Offset(1).Resize(lngRows, lngColumns + 1), .Offset(1, lngKeys) '比較用配列にデータを取得 vntData = .Offset(1, lngKeys).Resize(lngRows + 1).Value End With GetBasicData = True End Function Private Sub DataSort(rngScope As Range, _ rngKey As Range, _ Optional lngOrientation As Long = xlTopToBottom) rngScope.Sort _ Key1:=rngKey, Order1:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, _ Orientation:=lngOrientation, SortMethod:=xlStroke End Sub Private Function DataCompare(vntKeys1 As Variant, lngPos1 As Long, _ vntKeys2 As Variant, lngPos2 As Long) As Long ' データの大小比較 Dim i As Long '比較位置がDataEndを超えた場合 If lngPos1 > UBound(vntKeys1, 1) - 1 Then DataCompare = 1 Exit Function End If If lngPos2 > UBound(vntKeys2, 1) - 1 Then DataCompare = -1 Exit Function End If 'もし、Keyが不一致なら If vntKeys1(lngPos1, 1) = vntKeys2(lngPos2, 1) Then '戻り値の値として、「等しい」を返す DataCompare = 0 Else 'vntKeys1の値が、vntKeys2の値因り小さい場合 If vntKeys1(lngPos1, 1) < vntKeys2(lngPos2, 1) Then '戻り値の値として、「小さい」を返す DataCompare = -1 Else '戻り値の値として、「大きい」を返す DataCompare = 1 End If End If End Function (Bun) ---- ◆関数による回答です 【Sheet1】 [A] [B] [1] 番号 名前 [2] 11 桃 [3] 22 林檎 [4] 555 蜜柑 [5] 33 檸檬 [6] 777 葡萄 [7] 88 西瓜 【Sheet2】 [A] [B] [1] 番号 名前 [2] 99 メロン [3] 99 メロン [4] 11 桃 [5] 777 葡萄 [6] 777 葡萄 [7] 777 葡萄 [8] 22 林檎 [9] 777 葡萄 [10] 22 林檎 [11] 44 パイン 【Sheet3】 [A] [B] [C] [D] [E] [1] AシートにあってBシートにないもの BシートにあってAシートにないもの [2] 番号 名前 番号 名前 [3] 555 蜜柑 99 メロン [4] 33 檸檬 44 パイン [5] 88 西瓜 [6] [7] [8] AシートにもBシートにもあるものの件数 [9] 3 ◆Sheet3の式 A3=IF(ROW(A1)>SUMPRODUCT((COUNTIF(Sheet2!$A$2:$A$20,Sheet1!$A$2:$A$20)=0)*(Sheet1!$A$2:$A$20<>"")),"", INDEX(Sheet1!$A$1:$A$20,SMALL(INDEX((COUNTIF(Sheet2!$A$2:$A$20,Sheet1!$A$2:$A$20)>0)*10^5+ROW($A$2:$A$20),),ROW(A1)))) ★下にコピー B3=IF(A3="","",VLOOKUP(A3,Sheet1!$A$1:$B$20,2,0)) D3=IFERROR(INDEX(Sheet2!$A$2:$A$20,SMALL(((COUNTIF(Sheet1!$A$2:$A$20, IFERROR((FREQUENCY(Sheet2!$A$2:$A$20,Sheet2!$A$2:$A$20)>0)*Sheet2!$A$2:$A$21,0))>0) +(IFERROR((FREQUENCY(Sheet2!$A$2:$A$20,Sheet2!$A$2:$A$20)>0)*Sheet2!$A$2:$A$21,0)=0))*10^5+ROW($A$1:$A$20),ROW(A1))),"") ★この式は「配列数式」です。式を入力後、CtrlとShiftを押しながらEnterを押して式を確定させてください ★式が確定すれば、式の両端に、｛ ｝がつきます ★式を確定後に、下にコピー E3=IF(D3="","",VLOOKUP(D3,Sheet2!$A$1:$B$20,2,0)) >AシートにもBシートにもあるものの件数 A9=SUMPRODUCT((COUNTIF(Sheet2!$A$2:$A$20,Sheet1!$A$2:$A$20)>0)*1) (Maron) ---- 表の1行目には見出しが有るものとし 表がA1セルから始まっている事を想定しています。 考え方としては Aシートの C列に、COUNTIF関数で 同じ番号がBシートに何回出てくるか数える Bシートの C列に、COUNTIF関数で 同じ番号がAシートに何回出てくるか数える Cシートには AシートのC列が「0」の物が Aシートにだけ有るもの BシートのC列が「0」の物が Bシートにだけ有るもの なので、フィルタオプションの設定で重複を除いて 抽出。 また、AシートのC列が「0より大」の物が Bシートにも有るものなので COUNTIF関数で件数を数える。 手作業でもそんなに大変な作業では無いとは思いますが （頻度にもよるでしょうけれど。。。） コードが↓ '------ Sub KyuA() Const S_Sh1 As String = "Aシート" '←重複の無い方のシート Const S_Sh2 As String = "Bシート" '←重複の有る方のシート Const K_Sh1 As String = "Cシート" '←結果を出すシート名 Dim MxR1 As Long, MxR2 As Long Dim MySh As Worksheet Application.ScreenUpdating = False 'S_Sh1にCOUNTIF関数を設定 With Sheets(S_Sh1) MxR1 = .Range("A" & Rows.Count).End(xlUp).Row Call CntIfFx(S_Sh1, MxR1, S_Sh2) '両方に有るものの件数を数える .Range("D1").Value = "=COUNTIF(C1:C" & MxR1 & ","">0"")" End With 'S_Sh2にCOUNTIF関数を設定 With Sheets(S_Sh2) MxR2 = .Range("A" & Rows.Count).End(xlUp).Row Call CntIfFx(S_Sh2, MxR2, S_Sh1) End With With Sheets(K_Sh1) .Cells.ClearContents '検索条件設定 .Range("I1").Value = "COUNTIF" .Range("I2").Value = 0 'S_Sh1にだけ有るものを抽出&ソート .Range("A1").Value = S_Sh1 & "にだけある" Call Adv_Sor("A", S_Sh1, MxR1, K_Sh1) 'S_Sh2にだけ有るものを抽出&ソート .Range("D1").Value = S_Sh2 & "にだけある" Call Adv_Sor("D", S_Sh2, MxR2, K_Sh1) '検索条件削除 .Columns("I").Delete Shift:=xlToLeft '両方に有る物の件数を表示 .Range("G1").Value = "両方にある件数" .Range("G2").Value = Sheets(S_Sh1).Range("D1").Value End With 'COUNTIF関数を入れた列を削除 For Each MySh In Sheets(Array(S_Sh1, S_Sh2)) MySh.Columns("C:D").Delete Shift:=xlToLeft Next Sheets(K_Sh1).Select Application.ScreenUpdating = True MsgBox "処理が終了しました。" End Sub '====== Sub CntIfFx(MySh As String, MxR As Long, AtSh As String) '列を挿入して、見出しと、COUNTIF関数を設定 With Sheets(MySh) .Columns("C:D").Insert Shift:=xlToRight .Range("C1").Value = "COUNTIF" .Range("C2:C" & MxR).Value = "=COUNTIF(" & AtSh & "!A:A,A2)" End With End Sub '====== Sub Adv_Sor(MyC As String, MySh As String, MxR As Long, K_Sh As String) With Sheets(K_Sh) 'フィルタオプションの設定でデータを抽出 .Range(MyC & "2").Resize(, 2).Value = Sheets(MySh).Range("A1:B1").Value Sheets(MySh).Range("A1:C" & MxR).AdvancedFilter _ Action:=xlFilterCopy, CriteriaRange:=.Range("I1:I2"), _ CopyToRange:=.Range(MyC & "2").Resize(, 2), Unique:=True '並べ替え .Range(MyC & "2").Resize(.Range(MyC & Rows.Count).End(xlUp).Row, 2) _ .Sort Key1:=.Range(MyC & "2"), Order1:=xlAscending, _ Header:=xlYes, Orientation:=xlTopToBottom End With End Sub '------ (HANA) ---- よく考えると、 重複がある方のシートのデータ量が 重複が無い方のシートのデータ量より少なく成る可能性 って 有りますよね。 「必ず多い」印象で作ってましたので、一部分ですが↑直接書き直しました。 COUNTIF関数を設定する所が、なんだか大仰ですが。。。 (HANA) ---- やっぱり、Dictionaryを使った方が整列で処理するより簡単で速いかな? HANAさんが数式で処理している所を、Dictionaryで処理に変更した様な処理に成ります Option Explicit Public Sub DataMatch_2() 'Dictionary版 'Aシートのデータ列数（A列〜B列） Const clngColumnsA As Long = 2 'Aシートの比較する列の列位置(基準セル位置からの列Offset:A列) Const clngKeysA As Long = 0 'Bシートのデータ列数（A列〜B列） Const clngColumnsB As Long = 2 'Bシートの比較する列の列位置(基準セル位置からの列Offset:A列) Const clngKeysB As Long = 0 Dim i As Long Dim rngListA As Range Dim vntListA As Variant Dim lngRowsA As Long Dim lngFlagA() As Long Dim rngListB As Range Dim vntListB As Variant Dim lngRowsB As Long Dim lngFlagB() As Long Dim rngResultA As Range Dim rngResultB As Range Dim rngResultAB As Range Dim lngCountAB As Long Dim dicIndex As Object Dim strProm As String 'AシートのA1を基準とします(列見出しが有るとします) '★実際のシート名に変更する事 Set rngListA = Worksheets("Sheet1").Cells(1, "A") 'BシートのA1を基準とする(列見出しが有るとします) '★実際のシート名に変更する事 Set rngListB = Worksheets("Sheet2").Cells(1, "A") '画面更新を停止 Application.ScreenUpdating = False '「結果出力」の位置を指定します '★実際のシート名に変更する事 With Worksheets("Sheet3") Set rngResultA = .Cells(1, "A") Set rngResultB = .Cells(1, "E") Set rngResultAB = .Cells(1, "I") .UsedRange.ClearContents End With 'Dictionaryオブジェクトを取得 Set dicIndex = CreateObject("Scripting.Dictionary") 'Aシートの基準に就いて If Not GetBasicData(rngListA, lngRowsA, clngKeysA, vntListA) Then strProm = rngListA.Value & "にデータが有りません" GoTo Wayout End If '抽出Flagを確保 ReDim lngFlagA(1 To lngRowsA, 1 To 1) 'Bシート基準に就いて If Not GetBasicData(rngListB, lngRowsB, clngKeysB, vntListB) Then strProm = rngListB.Value & "にデータが有りません" GoTo Wayout End If '抽出Flagを確保 ReDim lngFlagB(1 To lngRowsB, 1 To 1) With dicIndex 'Bシートの値をDictionaryに登録 For i = 1 To lngRowsB If .Exists(vntListB(i, 1)) Then '登録が在ったらFlagを立てる lngFlagB(i, 1) = 1 Else '無ければ、行番号をItemとして登録 .Item(vntListB(i, 1)) = i End If Next i 'Aシートの値がDictionaryに在るかを確認 For i = 1 To lngRowsA '登録が在ったら If .Exists(vntListA(i, 1)) Then 'Matchしたとしてカウント lngCountAB = lngCountAB + 1 'AシートにFlagを立てる lngFlagA(i, 1) = 1 'BシートにFlagを立てる lngFlagB(.Item(vntListA(i, 1)), 1) = 1 End If Next i End With '出力範囲に結果を出力 OutPut rngListA, rngResultA, clngColumnsA, lngRowsA, lngFlagA, _ rngListA.Parent.Name & "に在って、" & rngListB.Parent.Name & "に無い物" '出力範囲に結果を出力 OutPut rngListB, rngResultB, clngColumnsB, lngRowsB, lngFlagB, _ rngListB.Parent.Name & "に在って、" & rngListA.Parent.Name & "に無い物" With rngResultAB .Value = rngListA.Parent.Name & "にも" & rngListA.Parent.Name & "にもある物の件数" .Offset(1).Value = lngCountAB End With strProm = "処理が完了しました" Wayout: '画面更新を再開 Application.ScreenUpdating = True Set rngListA = Nothing Set rngListB = Nothing Set rngResultA = Nothing Set rngResultB = Nothing Set rngResultAB = Nothing Set dicIndex = Nothing MsgBox strProm , vbInformation End Sub Private Function GetBasicData(rngList As Range, _ lngRows As Long, _ lngKeys As Long, _ vntData As Variant) As Boolean '基準に就いて With rngList '行数を取得 lngRows = .Offset(.Parent.Rows.Count - .Row, lngKeys).End(xlUp).Row - .Row 'データが無ければFunctionを抜ける(戻り値=False) If lngRows <= 0 Then Exit Function End If '比較用配列にデータを取得 vntData = .Offset(1, lngKeys).Resize(lngRows + 1).Value End With GetBasicData = True End Function Private Sub OutPut(rngList As Range, rngResl As Range, lngColu As Long, lngRows As Long, lngF() As Long, strProm As String) Const cstrNum As String = "No" '出力範囲に題名等を出力 With rngResl .Value = strProm rngList.Resize(1, lngColu).Copy Destination:=.Offset(1) .Offset(1, lngColu).Value = cstrNum .Offset(2, lngColu).Value = "=0" End With With rngList 'Flagを出力 .Offset(, lngColu).Value = cstrNum .Offset(1, lngColu).Resize(lngRows).Value = lngF End With 'シートのデータをフィルタ出力 DoFilter rngList.Resize(lngRows + 1, lngColu + 1), _ rngResl.Offset(1, lngColu).Resize(2), _ rngResl.Offset(1).Resize(, lngColu) '作業列をクリア rngResl.Offset(1, lngColu).Resize(2).ClearContents rngList.Offset(, lngColu).EntireColumn.ClearContents End Sub Private Sub DoFilter(rngScope As Range, _ rngCriteria As Range, _ rngCopyTo As Range, _ Optional blnUnique As Boolean) ' AdvancedFilterを実行 rngScope.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=rngCriteria, _ CopyToRange:=rngCopyTo, _ Unique:=blnUnique End Sub (Bun) ---- Dictionaryを繰り返し使用してみました（マナ） Sub test() Dim dicA As Object, dicB As Object, dicC As Object, dicBonly As Object, dicAonly As Object Dim rngA As Range, rngB As Range Dim c Dim keyAonly, keyBonly, itemAonly, itemBonly Dim i As Long Dim V1(), V2() Set dicA = CreateObject("Scripting.Dictionary") Set dicB = CreateObject("Scripting.Dictionary") Set dicBonly = CreateObject("Scripting.Dictionary") Set dicAonly = CreateObject("Scripting.Dictionary") Set dicC = CreateObject("Scripting.Dictionary") Set rngA = Sheets("Aシート").Range("A2", Sheets("Aシート").Cells(Rows.Count, 1).End(xlUp)) Set rngB = Sheets("Bシート").Range("A2", Sheets("Bシート").Cells(Rows.Count, 1).End(xlUp)) 'A一覧取得 For Each c In rngA If Len(c.Value) > 0 Then dicA(c.Value) = c.Offset(, 1).Value End If Next 'B一覧取得 For Each c In rngB If Len(c.Value) > 0 Then If Not dicB.exists(c.Value) Then dicB(c.Value) = c.Offset(, 1).Value End If End If Next 'Aのみ For Each c In dicA.keys If Not dicB.exists(c) Then dicAonly(c) = dicA(c) End If Next keyAonly = dicAonly.keys itemAonly = dicAonly.items If dicAonly.Count > 0 Then ReDim V1(1 To dicAonly.Count, 1 To 2) For i = 1 To dicAonly.Count V1(i, 1) = keyAonly(i - 1) V1(i, 2) = itemAonly(i - 1) Next Else ReDim V1(1 To 1, 1 To 2) V1(1, 1) = "ありません" End If 'Bのみ For Each c In dicB.keys If Not dicA.exists(c) Then dicBonly(c) = dicB(c) End If Next keyBonly = dicBonly.keys itemBonly = dicBonly.items If dicBonly.Count > 0 Then ReDim V2(1 To dicBonly.Count, 1 To 2) For i = 1 To dicBonly.Count V2(i, 1) = keyBonly(i - 1) V2(i, 2) = itemBonly(i - 1) Next Else ReDim V2(1 To 1, 1 To 2) V2(1, 1) = "ありません" End If '両方あるもの For Each c In dicA.keys If dicB.exists(c) Then dicC(c) = dicB(c) End If Next For Each c In dicB.keys If dicA.exists(c) Then dicC(c) = dicA(c) End If Next With Sheets("Cシート") .Columns("A:H").ClearContents .Range("A1").Value = "AにあってBにない" .Range("A2").Resize(UBound(V1), 2).Value = V1 .Range("D1").Value = "BにあってAにない" .Range("D2").Resize(UBound(V2), 2).Value = V2 .Range("G1").Value = "両方にある" .Range("G2").Value = dicC.Count & "件" .Select End With Set rngA = Nothing Set rngB = Nothing Set dicA = Nothing Set dicB = Nothing Set dicBonly = Nothing Set dicAonly = Nothing Set dicC = Nothing End Sub ---- こんにちは、ありがとうございました。 できましたって言っていいのかわかりませんが、とにかく求めたいものが表示されました。 皆さんの知識に圧倒されっぱなしでなんというか恐縮しております。 キュア... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201203/20120316201345.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97068 documents and 608366 words.
訪問者：