人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのVBAについて質問です。

並び替えの処理を行い、データの埋め込み作業を自動で行うプログラムを作成したいと考えております。

プログラムを行うデータですが、以下のような状況です。(ページの続きが、今回作成したいプログラムの流れとなります。)

http://oskuni7.sakura.ne.jp/hatena/question6/hatena.htm

データ列M,Nの値を条件として、埋め込み用データの列Uと列Vのデータを自動で埋め込むプログラムです。


前回似た様なプログラムを作成して頂いたのですがその際の質問は以下になります。

http://q.hatena.ne.jp/1229390550

そこで教えていただいたプログラムのスクリプトは以下になります。

http://oskuni7.sakura.ne.jp/hatena/question4/saisyupin.txt

今回前回と違うところは

★埋め込み用のデータを削除しない。

★データを埋め込んだ後、データの列Mを第一条件で降順で並び替え、データ列Nを第二条件の昇順で並び替える。

所です。

お手数をおかけしますが時間があるかたでプログラムを作成できるかたおりましたらよろしくお願いいたします。




●質問者: aiomock
●カテゴリ:コンピュータ インターネット
✍キーワード:エクセル スクリプト データ プログラム 二条
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● Mook
●0ポイント

変更したいのは最後の処理の部分だけだのようですが、下記でご希望に添いますか。

Sub Aiomac再出品()
 Const DATA_START_LINE = 4

 Dim i As Long
'--- Step 1 ソート
 Range("A4:AG65535").Sort _
 Key1:=Range("AG4"), Order1:=xlAscending, _
 Key2:=Range("AF4"), Order2:=xlAscending, _
 Header:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
 
 Dim lastRow As Long
 lastRow = Range("AF" & Rows.Count).End(xlUp).Row
 
'--- Step 2 データ転記
 Dim pCode As String
 Dim bOverWrite As Boolean
 Dim srcRow As Long
 For i = DATA_START_LINE To lastRow
 If Cells(i, "AG").Value = pCode Then
 If bOverWrite = True And Cells(i, "AF") = 1 Then
 Range("A" & srcRow).Resize(1, 31).Copy _
 Destination:=Range("A" & i).Resize(1, 31)
 Cells(i, "AH") = "再出品"
 End If
 Else
 If Cells(i, "AF").Value = 0 Then
 bOverWrite = True
 pCode = Cells(i, "AG").Value
 srcRow = i
 Else
 bOverWrite = False
 End If
 End If
 Next

'--- ★★★Step 3 再ソート【変更部分】
 Range("A4:AG65535").Sort _
 Key1:=Range("M4"), Order1:=xlDescending, _
 Key2:=Range("N4"), Order2:=xlAscending, _
 Header:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End Sub

仕様と異なる部分がありましたら、コメントください。

◎質問者からの返答

ご回答ありがとうございます。

試してみます。


2 ● Mook
●100ポイント ベストアンサー

失礼しました。前回とは全く異なる処理だったのですね。

下記でどうでしょうか。

Sub Aiomock2()
 Const DATA_START_LINE = 4

 Dim i As Long
'--- Step 1 ソート
 Range("A4:AA65535").Sort _
 Key1:=Range("N4"), Order1:=xlAscending, _
 Key2:=Range("M4"), Order2:=xlAscending, _
 Header:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
 
 Dim lastRow As Long
 lastRow = Range("AF" & Rows.Count).End(xlUp).Row
 
'--- Step 2 データ転記
 Dim pCode As String
 Dim bOverWrite As Boolean
 Dim srcRow As Long
 For i = DATA_START_LINE To lastRow
 If Cells(i, "N").Value = Cells(i + 1, "N").Value _
 And Cells(i, "M").Value = 0 _
 And Cells(i + 1, "M").Value = 1 Then
 Cells(i + 1, "U").Value = Cells(i, "U").Value
 Cells(i + 1, "V").Value = Cells(i, "V").Value
 End If
 Next

'--- ★★★Step 3 再ソート【変更部分】
 Range("A4:AG65535").Sort _
 Key1:=Range("M4"), Order1:=xlDescending, _
 Key2:=Range("N4"), Order2:=xlAscending, _
 Header:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End Sub
◎質問者からの返答

ご回答ありがとうございます。

再度実行してみましたが、データがまた埋め込まれない状況でした。

原因が少しわからないです。。


3 ● airplant
●100ポイント

ポイントは不要です。

横から失礼します。Mookさんすみません。

動いていないのは下記部分と思います。

' lastRow = Range("AF" & Rows.Count).End(xlUp).Row
 lastRow = Range("AA" & Rows.Count).End(xlUp).Row

' なお、開始行が4行目以外のときには、下記の部分の4を直す
 Const DATA_START_LINE = 4

 Range("A4:AA65535").Sort _
 Key1:=Range("N4"), Order1:=xlAscending, _
 Key2:=Range("M4"), Order2:=xlAscending, _


余談ですが、この操作は結局列Nをキーにして、元データの値を2つ持って来たいということですね?

元データがダイナミックに変わるのかどうか不明ですが、通常はvlookup関数で十分にできると思います。


拙作ですが、こちらもご参考まで。

http://d.hatena.ne.jp/airplant/20070808/1186598203

http://d.hatena.ne.jp/airplant/20070612/1181669879

◎質問者からの返答

ご回答ありがとうございます。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ