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

前回質問したものです。
http://q.hatena.ne.jp/1251521432

できればMookさんにお願いできたら幸いです。

A1?J1、A10?J10、A13?J13、A16?J16、A19?J19、A22?J22(これらを★とします)

なのですが、25行下の、K28にもK3と同内容が入ることに気づきました。
たぶん仕様を誤って伝えていたかと思います。申し訳ありません。

私がしていただきたいのは、
K28に入る場合は、
★も25行下のところから抜き出して対応してもらいたいのです。
つまり参照元の対象は★から25行下ですので、
A26?J26、A35?J35、A38?J38、A41?J41、A44?J44、A47?J47
です。

K53はA51?J51・・・A72?J72という感じで、K78以下も同様です。

【前提】K列と★との位置関係はかわらないものとします。
↑この部分がわかりづらかったかもしれません。申し訳ございませんが、
よろしくお願いします。

●質問者: naranara19
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:A10 Kさん いもの 仕様 参照元
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● Mook
●80ポイント ベストアンサー

前回の仕様のままで、検索範囲をした場合です。

Option Explicit

'--------------------------------------------------------
' K 列のお勧め文を処理
'--------------------------------------------------------
Sub main()
'--------------------------------------------------------
 Dim lastRow As Long
 lastRow = Range("K" & Rows.Count).End(xlUp).Row

 Dim i As Long
 For i = lastRow - 1 To 1 Step -1
 If Cells(i, "K") = "お勧め文" Then
 Cells(i + 2, "K") = makeSentense(Cells(i + 1, "K"), i)
 End If
 Next
End Sub

'--------------------------------------------------------
Function makeSentense(srcStr As String, baseRow As Long)
'--------------------------------------------------------
 Dim RegExp As Object
 Dim Match As Object
 Set RegExp = CreateObject("VBScript.RegExp")
'--- [****] を検索
 RegExp.Pattern = "\[[^(\[\])]+\]"
 RegExp.Global = True  '複数マッチを有効にする
 For Each Match In RegExp.Execute(srcStr)
 srcStr = Replace(srcStr, Match.Value, getWord(Match.Value, baseRow - 1))
 Next
 makeSentense = srcStr
End Function

'--------------------------------------------------------
Function getWord(findWord, offsetRow As Long)
'--------------------------------------------------------
'--- ★定義範囲は下記の範囲
 Const KEYWORDS_BASE_RANGE = "A1:J1,A10:J10,A13:J13,A16:J16,A19:J19,A22:J22"
 getWord = "■■"
 
 Dim keyRange As Range
 Set keyRange = Range(KEYWORDS_BASE_RANGE).Offset(offsetRow, 0).Find(What:=findWord, lookat:=xlWhole)
 
 If keyRange Is Nothing Then Exit Function
 If IsError(keyRange.Offset(2, 0)) Then Exit Function
 If keyRange.Offset(2, 0) = "" Then Exit Function

 getWord = keyRange.Offset(2, 0).Value
End Function

もし単純に25行ごとに処理をしたいばあい、先頭の部分を

'--------------------------------------------------------
Sub main()
'--------------------------------------------------------
 Dim lastRow As Long
 lastRow = Range("K" & Rows.Count).End(xlUp).Row

 Dim i As Long
 For i = 1 To lastRow Step 25
 Cells(i + 2, "K") = makeSentense(Cells(i + 1, "K"), i)
 Next
End Sub

としてみてください。

◎質問者からの返答

ありがとうございます。どうもエラーがでるようでして、

下記にエクセルファイルの画像をのせておきましたので、一度ご覧いただけますでしょうか?(0913です)

http://photos.yahoo.co.jp/hatenasenyou19

お忙しい中ありがとうございます。

関連質問


●質問をもっと探す●



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