Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3371 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【62651】グループ内で番号付与するには にしもり 09/8/19(水) 12:55 質問[未読]
【62655】Re:グループ内で番号付与するには kanabun 09/8/19(水) 13:40 発言[未読]
【62661】Re:グループ内で番号付与するには にしもり 09/8/19(水) 15:52 質問[未読]
【62662】Re:グループ内で番号付与するには kanabun 09/8/19(水) 16:26 発言[未読]
【62663】Re:グループ内で番号付与するには にしもり 09/8/19(水) 16:53 お礼[未読]
【62651】グループ内で番号付与するには
質問  にしもり  - 09/8/19(水) 12:55 -
引用なし
パスワード
   こんにちは。
M.xlsというファイルに次のようなデータが入っています。
いま、IDが同じだったらJUSHOに応じてSENDIDを付与したいです。

たとえば、
+-----+-------------+------+
|　 ID|JUSHO　　　　|SENDID|
+-----+-------------+------+
|1　　|東京都千代田区1-1 |　　　|
+-----+-------------+------+
|1　　|東京都千代田区1-1 |　　　|
+-----+-------------+------+
|1　　|東京都練馬区1-1　|　　　|
+-----+-------------+------+
|1　　|東京都練馬区1-1　|　　　|
+-----+-------------+------+
|1　　|東京都千代田区1-1 |　　　|
+-----+-------------+------+
|1　　|東京都豊島区1-1　|　　　|
+-----+-------------+------+
|1　　|東京都千代田区1-2 |　　　|
+-----+-------------+------+
|2　　|東京都中央区1-1　　|　　　|
+-----+-------------+------+
|3　　|東京都渋谷区1-1　　|　　　|
+-----+-------------+------+

上記を以下のようにしたいのです。

+-----+-------------+------+
|　 ID|JUSHO　　　　|SENDID|
+-----+-------------+------+
|1　　|東京都千代田区1-1 |　　 1|
+-----+-------------+------+
|1　　|東京都千代田区1-1 |　　 1|
+-----+-------------+------+
|1　　|東京都練馬区1-1　|　　 2|
+-----+-------------+------+
|1　　|東京都練馬区1-1　|　　 2|
+-----+-------------+------+
|1　　|東京都千代田区1-1 |　　 1|
+-----+-------------+------+
|1　　|東京都豊島区1-1　|　　 3|
+-----+-------------+------+
|1　　|東京都千代田区1-2 |　　 4|
+-----+-------------+------+
|2　　|東京都中央区1-1　　|　　 1|
+-----+-------------+------+
|3　　|東京都渋谷区1-1　　|　　 1|
+-----+-------------+------+

そこでこう書きました。↓
Option Explicit

Sub Macro()

　　Dim myTxtFile As String
　　Dim i As Integer
　　Dim j As Integer
　　Dim k As Integer
　　　
　　Application.ScreenUpdating = False
　　myTxtFile = ActiveWorkbook.Path & "\M.xls"
　'　Worksheets("Sheet1").Activate
　　Open myTxtFile For Input As #1
　　
　　i = 1
　　k = 1

　　Do Until i = EOF
　　　　j = Cells(i, 1)
　　　　Cells(i, Offset(2)) = k
　　　　 If i = i + 1 Then Do:
　　　　　　Else: k = k + 1
　　
　　　　Next j
　　Loop
　　Close #1
　　
　　 ' ActiveWorkbook.Close True
　　
End Sub

ですが、引数は省略できません、と出ます。
基本的に間違ってますでしょうか。
いつもすみません。
【62655】Re:グループ内で番号付与するには
発言  kanabun  - 09/8/19(水) 13:40 -
引用なし
パスワード
   ▼にしもり さん：
こんにちは。

> 引数は省略できません、と出ます。
よく見てませんが、とりあえず
>　　Do Until i = EOF
は
>　　Do Until i = EOF(1)
です。カッコの中の1 は
ファイルに対するアクセス番号で、
> Open myTxtFile For Input As #1
の#1 のことです。

でも、そんなことより
なぜ
Openステートメントや
　 Do Until EOF(#1)
　 Loop
を使ってファイルを開いているのですか？
Openステートメントはテキストファイルを開くときの
ステートメントです。

> M.xlsというファイル
は Excel Book でしょ？
Bookを開くのは Workbooks.Openメソッドです。
これを使わないと、ワークシートの状態で開けません。

で、Workbooks.Openでその<M.xls> を開いて、
最初のシートに↓こうなっていたとします。

A　　　 B　　　　　　　　　C
ID　　JUSHO　　　　　　　 SENDID
1　　東京都千代田区1-1　
1　　東京都千代田区1-1　
1　　東京都練馬区1-1
1　　東京都練馬区1-1
1　　東京都千代田区1-1　
1　　東京都豊島区1-1
1　　東京都千代田区1-2　
2　　東京都中央区1-1
3　　東京都渋谷区1-1

メール用番号をC列に書き入れるにはまず、これをA列,B列で
ソートしておきます(優先順位1位：A列)

ID　　JUSHO　　　　　　　　SENDID
1　 東京都千代田区1-1　
1　 東京都千代田区1-1　
1　 東京都千代田区1-1　
1　 東京都千代田区1-2　
1　 東京都豊島区1-1
1　 東京都練馬区1-1
1　 東京都練馬区1-1
2　 東京都中央区1-1
3　 東京都渋谷区1-1

ソートされていれば、考え方のひとつとして、

'A列の2行目から下へ順に見ていって
For i = 2 to データ最終行番号

　 If Cell(i,1) の値が Cells(i-1,1)の値とちがっていたら、
　　　 SendId を初期値1 にして、C列に この値を入れる。
　 Else ひとつ上と同じIDなら、
　　　B列の値をひとつ上のセルの値と較べ、
　　　　 違っていれば、SendId番号を１つ増やして、これをC列に、
　　　　 同じならば、現在の変数SendId をC列に、
　　　End If
　End If

Next

とまぁ、こんな風にしても番号付けができるかと思います。
【62661】Re:グループ内で番号付与するには
質問  にしもり  - 09/8/19(水) 15:52 -
引用なし
パスワード
   ▼kanabun さん：

ありがとうございます。
　

> > M.xlsというファイル
> は Excel Book でしょ？
> Bookを開くのは Workbooks.Openメソッドです。
Mは或るシステムからダウンロードしてるためもとはcsvでしたので混乱しました。
M.xlsとして仰るとおりOpenメソッドで開くようにいたします。

アドバイスにしたがって書いてみました。
が、Rangeメソッドが失敗　と出ます。書き方が間違っていますでしょうか。
何卒御教示ください。

Option Explicit

Sub Macro1()

Dim i As Integer
Dim j As Integer

　　Workbooks.Open Filename:="U:\M.xls"
　　Worksheets("Sheet1").Activate
　
　　Range("A1").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Range(Selection, Selection.End(xlToRight)).Select
　　Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
　　　　, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
　　　　False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
　　　　xlSortNormal, DataOption2:=xlSortNormal

'↓100というのは仮で、xlDownでデータの在る最終行までとしたいです。
For i = 2 To 100
　 '↓ここが黄色になります
　　If Range(Cells(i, 1)).Value = Range(Cells(i - 1, 1)).Value Then
　　
　　　　j = 1
　　　　ActiveCell.Offset(0, 2).Range("A1").Select = j
　　　　
　　　　Else
　
　　　　　　If ActiveCell.Offset(0, 1).Range("A1").Select = ActiveCell.Offset(-1, 0).Range("A1").Select Then
　　　　　　　　　　
　　　　　　　　ActiveCell.Offset(0, 2).Range("A1").Select = j
　　　　　　　　Else
　　　　　　　　
　　　　　　　　j = 1
　　　　　　　　ActiveCell.Offset(0, 2).Range("A1").Select = j
　　　　　　
　　　　　　End If
　　　　　　
　　　　End If
　　　　
　　j = j + 1

Next

End Sub
【62662】Re:グループ内で番号付与するには
発言  kanabun  - 09/8/19(水) 16:26 -
引用なし
パスワード
   ▼にしもり さん：

>Mは或るシステムからダウンロードしてるためもとはcsvでしたので混乱しました。
>M.xlsとして仰るとおりOpenメソッドで開くようにいたします。
元がcsvファイルなら、Openメソッドで Bookと同じように 開けますよ

>が、Rangeメソッドが失敗　と出ます。書き方が間違っていますでしょうか。
>　 '↓ここが黄色になります
>　　If Range(Cells(i, 1)).Value = Range(Cells(i - 1, 1)).Value Then
このばあい、Rangeは不要ですよね？

Sub Macro1()

Dim i As Long 'Integer
Dim j As Long 'Integer
Dim SendID As Long '◆追加

　　Workbooks.Open Filename:="U:\M.xls"　'『M.csv』 でもいいです
　　Worksheets("Sheet1").Activate

'　　Range("A1").Select
'　　Range(Selection, Selection.End(xlDown)).Select
'　　Range(Selection, Selection.End(xlToRight)).Select
'　　Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
'　　　　, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
'　　　　False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin, DataOption1:= _
'　　　　xlSortNormal, DataOption2:=xlSortNormal

　　With Range("A1").CurrentRegion
　　　　.Sort Key1:=.Columns(1), Key2:=.Columns(2), Header:=xlYes
　　　　
　　　　'↓データの在る最終行まで
　　　　For i = 2 To .Rows.Count
　　　　　　If .Cells(i, 1).Value <> .Cells(i - 1, 1).Value Then
　　　　　　　　SendID = 1
　　　　　　　　.Cells(i, 3).Value = SendID
　　　　　　Else
　　　　　　　　If .Cells(i, 2).Value <> .Cells(i - 1, 2).Value Then
　　　　　　　　　　SendID = SendID + 1
　　　　　　　　End If
　　　　　　　　.Cells(i, 3).Value = SendID
　　　　　　End If
　　　　Next
　　End With
　
End Sub

のようではどうですか？
【62663】Re:グループ内で番号付与するには
お礼  にしもり  - 09/8/19(水) 16:53 -
引用なし
パスワード
   ▼kanabun さん：
できました。
ありがとうございます！

Forで最終行までの場合、.Rows.Countでよいのですね。
SendIDを変数として用いてよいのですね。
こういう場合はこう、というのがまだまだピンときません。
今後もよろしくお願いいたします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3371 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free