Re: 協力依頼２

"古川＠SSS"さんは[url:kb:254]で書きました:

〉おそらく、isbn のリストがあんまり長いと正常に解釈されないかと思うので、

〉１つを　２０個位で作りたいと思います。

〉どなたか、旧システムからＧＲ以外の本の
〉1) 小数点単位での　ＹＬ　ごとのデータを落とし
〉2) レベル別のデータを落とし、

〉update m_syuppan
〉 set nm_yle= 1.5,
〉 nm_yls= 1.5
〉where nm_yle is null
〉 and dt_isbn in ('0064451232','0689855850' );

〉 ^^^^^^^^^ この　（）内に２０個づついれる

方法ですが・・・

・書評の「●詳細条件検索」を開く
・「読みやすさレベル」を指定（左右とも同じレベル）
・「種類」を指定（GR以外を順次）
・「検索実行」ボタンを押す

・表示されたページの「CSV保存」を選択
・「ISBN」のみチェックを入れる
・判別できる名前を付けて保存（初期値では同じ名前になるので上書きに注意）

で・・・
Excelマクロを作りました。
・　　　　・　‥‥……━━━☆
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2004/5/3 ユーザー名 : foon
'
Dim i, j As Long

'最初の4行削除
For i = 1 To 4 Step 1
Range("A1").Select
Selection.Delete Shift:=xlUp
Next i

'「"」の挿入
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

j = 1

Do While Range("B" & j).Value <> ""

Range("A" & j).Select
ActiveCell.FormulaR1C1 = """"
Range("C" & j).Select
ActiveCell.FormulaR1C1 = """"
Range("D" & j).Select
ActiveCell.FormulaR1C1 = "= RC[-3] & RC[-2] & RC[-1]"

j = j + 1
Loop

j = 1
Do While Range("a1").Value <> ""

'シート間のコピー

Range("D1:D20").Select '20件のデータ指定
Selection.Copy

'コピー先シートの指定（Sheet2の場合）
Worksheets("Sheet2").Activate
Range("A" & j).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

'コピー元シートの指定（Book1の場合）
Worksheets("Sheet1").Activate

'コピー済み20行削除
For i = 1 To 20 Step 1
Range("A1:D1").Select
Selection.Delete Shift:=xlUp
Next i

j = j + 1
Loop

'
End Sub
・　　　　・　‥‥……━━━☆
マクロを動かして、CSVファイルで保存するとISBNが20個ずつ並ぶはずなんですが。

テストしたら「"」が三つづつ付いちゃいました(TT)

ひとまず、寝ます。

マクロ作るのも久しぶりだしなぁ・・・