プロが教える店舗&オフィスのセキュリティ対策術

こんにちは、お世話になっています。
表題のとおり、VBA内でコピペした値が、コピペ先の書式で表示ができなくて困っています。
状況としては、「指定したシート1上の範囲内のセルの文字列をコピーし、シート2で指定したセル内にペーストする」ということを行いたいのですが、貼り付けた値はコピペ元の書式で表示されてしまい、一度各セルをアクティブにしないとシート2の書式が適用されません。
どうすればアクティブにしなくても正常表示できるか、お知恵を貸してください。

なお、作成にあたり以下の条件があります。
(1)運用時に全シートはパスワード保護されるため、値に対しての入力や修正、及びショートカットやボタンによる動作は不可
(2)コピー元の書式は「文字列」固定、コピー先の書式は「ユーザー定義」固定で、さらに各行ごとに定義が異なる
(3)当マクロはファイル呼出時に自動的に実行される

以下、ソースコードになります(Excel2003 SP3、VB6.5で作成)

Dim first_Row As Integer 'シート1のデータ先頭行
Dim first_Col As Integer 'シート1のデータ先頭列
Dim last_Row As Integer 'シート1のデータ最終行
Dim last_Col As Integer 'シート1のデータ最終列
Dim first_KeyNo As Integer 'シート2のキー番号先頭行
Dim last_KeyNo As Integer 'シート2のキー番号最終行(今回省略)

(中略、↑のデータを各ワークシートからセット)

Dim i As Integer 'シート1のカウント用変数
Dim k As Integer 'シート2のカウント用変数

i = first_Row
k = first_KeyNo

'データ最終行になるまで処理を繰り返す
Do While(i >= first_Row and i < last_Row)

     'シート1と2のキーNoがイコールならセット
     If Worksheets("シート1").Cells(k, 1).Value = Worksheets("シート2").Cells(i, 2).value Then
          Worksheets("シート1").Range(Cells(i, first_Col),Cells(i, last_Col).Copy
          Worksheets("シート2").Range(Cells(k, 1),Cells(k, 20).PasteSpecial paste:=xlValues
          Application.CutCopyMode = False

     'イコールでないなら、イコールになるまでシート2のキー番号を検索
     ElseIf Then
          (中略)
     EndIf
     i = i + 1
     k = k + 1
Loop


VBAは今回初めて作成するので、見づらいかと思いますがよろしくお願いいたします。

A 回答 (2件)

こんばんは。



何か、凝った書き方していますが、難しい書き方になっているような気がします。
もう少し、楽に書いたほうがよいと思います。

内容的にはっきりしない部分がありますが、ペーストするときに、20列にしたいなら、コピーするときに、20列にすればよいです。Range プロパティの中で、Cells を指定すると、親オブジェクトとは共有していません。文字列の、"A1" などと入れるか、Resize で、範囲を広げます。

'-------------------------------------------
If Worksheets("シート1").Cells(k, 1).Value = Worksheets("シート2").Cells(i, 2).Value Then
    Worksheets("シート1").Cells(i, first_Col).Resize(,20).Copy
    Worksheets("シート2").Cells(k, 1).PasteSpecial Paste:=xlPasteValues
    ''Application.CutCopyMode = False ''マクロが終了する直前に入れること(ループ内では不要)
'-------------------------------------------

ただし、
If Worksheets("シート1").Cells(k, 1).Value = Worksheets("シート2").Cells(i, 2).value Then
シート2 の2列目で比較して、

Worksheets("シート2").Range(Cells(k, 1),Cells(k, 20))
と貼り付けるわけですから、1 列目に貼り付けるわけですから、場合によっては上書きもありうるということだと解釈しています。
    • good
    • 0
この回答へのお礼

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

固定範囲にしていないのは、このVBAの処理を別ファイルでも流用し、かつ各ファイルごとにシート1でコピーする列数が異なるため、なるべくハードコーティングを行いたくないからです。
また、行数も異なり、シート2上にキー番号が存在していてもシート1上に対応するキー番号がない可能性があるため、ループ処理にしています。
それと、Rangeプロパティ中にCellsを記述していないのは文字数の都合上省略したためです。
実際のソースでは記述し、動作テストは完了しています。
混乱させてしまい、申し訳ありません。

>If Worksheets("シート1").Cells(k, 1).Value = Worksheets("シート2").Cells(i, 2).value Then
>シート2 の2列目で比較して、

>Worksheets("シート2").Range(Cells(k, 1),Cells(k, 20))
>と貼り付けるわけですから、1 列目に貼り付けるわけですから、場合によっては上書きもありうるということだと解釈しています。
これは完全に、当方の質問に書き込んだ際の記述ミスです。
シート1はどちらもk、シート2ではiを使って処理させています。

お礼日時:2009/12/09 23:09

こんばんは。



Rangeの前だけではなく、Cellsの前にもWorksheetsを指定する必要があります。

例えば、以下は
Worksheets("シート1").Range(Cells(i, first_Col),Cells(i, last_Col))

Worksheets("シート1").Range(Worksheets("シート1").Cells(i, first_Col),Worksheets("シート1").Cells(i, last_Col))
または
With Worksheets("シート1")
 .Range(.Cells(i, first_Col),.Cells(i, last_Col)) 
End With
のように記述する必要があります。

Worksheets("シート2").Range(Cells(k, 1),Cells(k, 20))
も同様に変更が必要です。
例えば
With Worksheets("シート2")
 .Range(.Cells(k, 1),.Cells(k, 20))
End With

お試しください。
    • good
    • 0
この回答へのお礼

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

No1の方へのお礼にも書きましたが、Rangeプロパティ中にCellsを記述していないのは文字数の都合上省略したためです。
実際のソースでは記述し、動作テストは完了しています。
混乱させてしまい、申し訳ありません。

お礼日時:2009/12/09 23:10

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!