[[20100621134517]]　『ハイパーリンクの一括コピー』（まちゃ）　ページの最後に飛ぶ

『ハイパーリンクの一括コピー』（まちゃ）

Excel2000　WindowsXP使用

お世話になっております。

今回、パイパーリンクの設定がされているセルが複数列（２０列ぐらい）にあり、行はデータが3万件、そのうちハイパーリンクされている行は２万件ぐらいあります。

しかし、データの更新の時期となり苦労して作ったファイルを作り直す作業をしております。

ハイパーリンク設定されているセルの表示はアドレスではなく簡単な表記にしてしまいましたが、今回はアドレスをコピーしたいのです。

過去ログに一列のみのやり方がありました。
これを使ってと思ったらやはり気が遠くなりでもどのようにVBAを変更してよいのやら…

ご教授よろしくお願いいたします。

ファイルＡ（元データ・ハイパーリンク設定が複数行列にあるが表示はアドレスではない）

　　　Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ

１　りんご　１　　２　　３　　４　　←ハイパーリンク設定されています。

２　イチゴ　１　　２　　３　　４

３　キウイ

４　メロン　１

５　バナナ　１　　２

ファイルＢ（更新されたデータ。ハイパーリンクの貼り付け先）

　　　Ａ　　Ｂ　　Ｃ　　Ｄ　　Ｅ

１　りんご　　　　　　　　　　　　←Ａ列は更新されて追加や削除あり

２　イチゴ

３　キウイ

４　スイカ

５　バナナ

　
ファイルＢのＢ列以降にファイルＡのハイパーリンクをコピーしたいのです…

本来はアドレスのコピーではなく表記もアドレスも同じ状態でＡ→Ｂに引っ張ってきたいのですが…もし可能であればそのほうが先の手順がひとつ減って時間短縮になるのですが…　
よろしくお願いいたします。

 こんな感じでコピーでいけますか。
 2万行もあったら時間かかるかもしれません。
元に戻せませんので、コピーしたブックで試してください。
Sub Test()
Dim wb1 As Workbook, wb2 As Workbook
Dim mysh1 As Worksheet, mysh2 As Worksheet
Dim rng_newRange As Range, rng_serchRange As Range, C As Range
Dim lng_lastRow As Long
Dim lng_myRow
Const sh1 As String = "Sheet1"  '元のブックのシート名
Const sh2 As String = "Sheet1"  '新のブックのシート名
Set wb1 = Workbooks("Book1")    '元のブック
Set wb2 = ThisWorkbook          '新ブック（マクロを登録したブック）
　
Set mysh1 = wb1.Worksheets(sh1)
Set mysh2 = wb2.Worksheets(sh2)
　
lng_lastRow = mysh2.Range("A1").End(xlDown).Row  '新ブックの最終行
　
Set rng_newRange = Range(mysh2.Range("A1"), mysh2.Range("A1").End(xlDown))    '新ブックのデータ範囲（A列）
Set rng_serchRange = Range(mysh1.Range("A1"), mysh1.Range("A1").End(xlDown))  '元ブックのデータ範囲（A列）
　
For Each C In rng_newRange
    lng_myRow = Application.Match(C.Value, rng_serchRange, 0)
    If IsNumeric(lng_myRow) Then
        Range(mysh1.Cells(lng_myRow, 2), mysh1.Cells(lng_myRow, 2).End(xlToRight)).Copy _
        Destination:=C.Offset(, 1)
    End If
Next C
　
Set wb1 = Nothing
Set wb2 = Nothing
Set mysh1 = Nothing
Set mysh2 = Nothing
Set rng_newRange = Nothing
Set rng_serchRange = Nothing
　
End Sub

 （川野鮎太郎）

（川野鮎太郎）様

ご回答ありがとうございます。
早速試してみましたが、欲しいデータがコピーできません。
以下の点を教えてくださいませ。

VBA は全くの初心者で、そのままコピペしてブック名とシート名とデータ範囲を
変更して実行しました。

lng_lastRow = mysh2.Range("A1").End(xlDown).Row '新ブックの最終行

↑("A1")これはどこを指しますか？

　
Set rng_newRange = Range(mysh2.Range("A1"), mysh2.Range("A1").End(xlDown)) '新ブックのデータ範囲（A列）

↑("A1")　＝　'新ブックのデータ範囲（A列）　ですよね？どこを指しますか？実際のファイルは
A列～X列までデータがあり、元ブックとはX列にある“コード”フィールドが同じになっています。

Set rng_serchRange = Range(mysh1.Range("A1"), mysh1.Range("A1").End(xlDown)) '元ブックのデータ範囲（A列）

↑("A1")　＝　'元ブックのデータ範囲（A列）　ですよね？こちらもどこを指しますでしょうか？
実際は元ブックもA列～BC列までデータがありP列に新ブックのX列と同じ“コード”フィールドがあります。それ以降Q列～BC列までのデータがコピーしたいデータとなります。

分からないながら

lng_lastRow = mysh2.Range("A1").End(xlDown).Row '新ブックの最終行

Set rng_newRange = Range(mysh2.Range("X1"), mysh2.Range("X1").End(xlDown)) '新ブックのデータ範囲（A列）
Set rng_serchRange = Range(mysh1.Range("P1"), mysh1.Range("P1").End(xlDown)) '元ブックのデータ範囲（A列）

として実行しましたが、元ブックのB列～E列がコピーされました。

こんなこともわからないのか？という質問かもしれませんが、どうかご教授お願いいたします。

（まちゃ）

 えっと、、、言葉での説明は良く理解できないので、最初のご質問のような
 行列配置を記載して説明してもらえませんでしょうか。

 （川野鮎太郎）

（川野鮎太郎様）

大変お騒がせいたしました。
とりあえず、ご教授いただいた方法でできました。

２万件を種類ごとに分割して少しづつ実行していきました。

強制終了することなく無事に終わりそうです。
（最後に分割したデータを統合して出来上がりです。）

私もどうしても言葉では伝えにくくどうしたものかと入力していたら
このような状況になり分かりずらくなりすみませんでした。

でも本当に助かりました。

ＶＢＡって何でもできるんですね…
とういうか川野さんはすごい方です。

たぶんまたつまづくことがあると思います。
ぜひその時はよろしくご教授のほどお願いいたします。

（まちゃ）

コメント返信：

[ 一覧(最新更新順) ]

[[20100621134517]] 『ハイパーリンクの一括コピー』（まちゃ） ページの最後に飛ぶ

[[20100621134517]]　『ハイパーリンクの一括コピー』（まちゃ）　ページの最後に飛ぶ