×

[PR]この広告は3ヶ月以上更新がないため表示されています。
ホームページを更新後24時間以内に表示されなくなります。

オフライン集計方法forエクセルマクロ 2013.1.25更新


必要なもの

 MSオフィスのマクロが使えるバージョン(下記マクロは2010の32bit版で作成してます)
 使いやすいテキストエディタ (gpadとかmeryとかマクロが使えるので便利)
 dat(自動クロールしておくと便利)

①datをテキストエディタで開き、開始時刻の行をクリック、終了時刻の行をShift+クリック(1000またぐ場合は1000でShift+クリック)後、コピー
②エクセルを開き、コピーしたものをA列にペースト。①②をスレの数だけ繰り返す(※)
③コピーが済んでから↓マクロを実行すると、最多レス者、レス数、参加者、3桁発言者の順にクリップボードにコピーされる。具体的には「列選択→区切り位置→ピボットテーブル→レス数等カウント→コピー」。

Sub レス集計v2()
Columns("D:D").Select

Selection.NumberFormatLocal = "[$-F400]h:mm:ss.00 AM/PM"

Range("A1:A" & Range("A1").End(xlDown).Row).Select
Dim SCN As Variant
Dim REP As Variant
Dim i As Integer

'都合よく区切るための置換。header、footerは、nicort用データ作成と同時に集計もしているので通常はいらない
SCN = Array("*<> 集計*", "*Over 1000 Thread<>*", "nicort用データ<>*", "@", "*<>*<>????/", "<>")
REP = Array("header集計除外", "1001集計除外", "footer集計除外", "", "集計対象<><>", "@")

For i = LBound(SCN) To UBound(SCN)

Selection.Replace What:=SCN(i), Replacement:=REP(i)

Next

Application.DisplayAlerts = False
Selection.TextToColumns _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar _
:="@", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

Selection.TextToColumns DataType:=xlDelimited _
, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
:="@", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

Columns("C:C").Select
ActiveWorkbook.Worksheets(1).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(1).Sort.SortFields.Add Key:=Range("D1:D65536" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(1).Sort
.SetRange Range("A1:IQ65536")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Rows("1:1").Select
Selection.Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E1").Select
ActiveCell.FormulaR1C1 = "レス数"
ActiveCell.Characters(1, 3).PhoneticCharacters = "レススウ"

Columns("E:E").Select
Sheets.Add.Name = "ピボットテーブル"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"R1C5:R1048576C5", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="ピボットテーブル!R3C1", TableName:="ピボットテーブル", DefaultVersion _
:=xlPivotTableVersion14
Sheets("ピボットテーブル").Select

ActiveSheet.PivotTables("ピボットテーブル").PivotFields("レス数"). _
Orientation = xlHidden
With ActiveSheet.PivotTables("ピボットテーブル")
.PivotFields("レス数").Orientation = xlRowField
.AddDataField .PivotFields("レス数"), "レス数(昇順)", xlCount
End With

Range("A5").Select
ActiveSheet.PivotTables("ピボットテーブル").PivotFields("レス数").AutoSort xlDescending _
, "レス数(昇順)", ActiveSheet.PivotTables("ピボットテーブル").PivotColumnAxis. _
PivotLines(1), 1

ActiveSheet.PivotTables("ピボットテーブル").ColumnGrand = False
ActiveSheet.PivotTables("ピボットテーブル").RowGrand = False

Range("C4").Select
ActiveCell.FormulaR1C1 = "=(SUM(C[-1]))"
Range("D4").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],""ID:*"")"
Range("E4").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(C[-3],"">=100"")"
Range("F4").Select
ActiveCell.FormulaR1C1 = "=LEFT(RC[-5],11)"
Range("G4").Select
ActiveCell.FormulaR1C1 = "=LEFT(R[1]C[-6],11)"
Range("H4").Select
ActiveCell.FormulaR1C1 = "=LEFT(R[2]C[-7],11)"

Range("A3").Select
With ActiveSheet.PivotTables("ピボットテーブル").PivotFields("レス数")
.Orientation = xlRowField
.Position = 1


Range("B4:F4").copy
End With

'集計したデータとピボットテーブルのシートを消す操作。コメントアウトを外せば動作
' waitTime = Now + TimeValue("0:00:01")
' Application.Wait waitTime

' ActiveWindow.SelectedSheets.Delete
' Cells.Select
' Selection.ClearContents
' Range("A1").Select

End Sub

このマクロは、ネットの例文や知恵袋等の回答、マクロ記録などを参照しながら継ぎ接ぎしたマクロです。

※複数スレをコピーをする場合は、クリップボード略歴ソフトを使うと便利。これとかこれとか。さらにエクセルで「最終行の一つ下を選択」というマクロを組んでおくと、略歴からペースト→マクロ→略歴からペースト→マクロ・・・の繰り返しで集計対象レスがコピーされていく。自分は、nicort用データ作成も兼ねているのでテキストエディタで対象レスを束ねて保存→コピー→エクセルに貼り付け→集計という流れ。

Sub A列最終行の一つ下を選択()

Range("A3").End(xlDown).Select
Selection.Offset(1, 0).Select

End Sub