アプリ版:「スタンプのみでお礼する」機能のリリースについて

以下のマクロはA列になっていますが
これを K列にしたいのですが
自分でもAに関連する場所をKにしたのですが失敗になってしまいます。
参考)http://32877.xii.jp/view/265 からのコピーです。


A列の情報をもとに重複のないワークシートを挿入し、
上記3つのリストをそれぞれのシートにコピペする方法。


Sub Make_Fruits_Sheet()
'====================================================================================
' A列のデータでフィルタリングして別シートを作成しフィルタリングしたリストをコピペする
'====================================================================================
ThisWorkbook.Activate
'//変数の定義
Dim arrayData, i, maxRow As Long
Dim cellData As String
Set arrayData = CreateObject("Scripting.Dictionary")
On Error Resume Next
'//A列の最終行を取得
If Len(Worksheets(1).Range("A1").Value) = 0 Then
maxRow = 0
ElseIf Len(Worksheets(1).Range("A2").Value) = 0 Then
maxRow = 1
Else
maxRow = Worksheets(1).Range("A1").End(xlDown).Row
End If
'//A列のデータを連想配列に格納する
For i = 2 To maxRow
'//セルの値を変数cellDataに格納
cellData = Range("A" & i).Value
'//連想配列に未登録であればセルの値を連想配列に格納する
If Not arrayData.Exists(cellData) Then
arrayData.Add cellData, cellData
End If
Next i
'//連想配列のキーを定義する
arrayDataKeys = arrayData.Keys
'//連想配列のデータ分繰り返して作業する
For i = 0 To arrayData.Count - 1
'//新しいワークシートを挿入する
Dim NewWorkSheet As Worksheet
Set NewWorkSheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
'//新しいワークシートの名前を変える
NewWorkSheet.Name = arrayDataKeys(i)
'//元のシートをフィルタリングしてコピーする
With Worksheets(1).Range("A1")
.AutoFilter Field:=1, Criteria1:=arrayDataKeys(i) '1列目を連想配列のデータで絞り込む
.CurrentRegion.Copy
End With
'//新しいワークシートにペーストする
Sheets(arrayDataKeys(i)).Paste
Next i
'//フィルタを解除する
With Worksheets(1)
.Activate '最初のシートをアクティブにする
.Range("A1").AutoFilter 'フィルタを解除する
End With
'//オブジェクトを初期化して終了
Set arrayData = Nothing
End Sub

A 回答 (2件)

まず確認です。

A列→K列に変更する前はうまく作動するのを確認されましたでしょうか?

当方のエクセル(2007)では、冒頭に『Dim arrayDataKeys』が必要でした。
これはバージョンによるものかもしれませんが、一応追加しておいてください。

◆結論
以下のように変更が必要です。
変更前: .AutoFilter Field:=1, Criteria1:=arrayDataKeys(i) '1列目を連想配列のデータで絞り込む
変更後: .AutoFilter Field:=11, Criteria1:=arrayDataKeys(i) '11列目=K列

以下はA→Kに修正済みですよね?
Range("A1")
Range("A2")
Range("A" & i).Value

ご自分で試した結果、うまくいかなかった内容を記載されたほうが、よい回答がつきやすいですよ。
    • good
    • 0

こんにちは



内容は見ていませんが、単純にA列→K列に置き換えれば良さそうですけれど・・・
>自分でもAに関連する場所をKにしたのですが失敗になってしまいます。
どう直したのかもエラーの内容もわからないので何ともわかりませんが、修正するのが難しいのであれば・・・

実行前に、『A列を新規挿入して、そこへK列の内容をコピーする』マクロを追加することで、修正しなくともそのまま利用ができるのではないでしょうか?
(必要なら、終了後にA列の削除も追加しておく)
    • good
    • 0

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