A 回答 (7件)
- 最新から表示
- 回答順に表示
No.7
- 回答日時:
No6です。
本件、一旦締め切って、excelのカテゴリで再度質問されてはいかがでしょうか。
コンピューター・テクノロジー >Microsoft Office >Excel(エクセル)
のカテゴリなら、excel関数の達人が回答してくれると思います。
その際は、excel関数での実装を条件として提示すれば良いかと思います。
No.6
- 回答日時:
No5です。
>ご用意頂いたコードを標準モジュールに設定してみました。ただ、実行しようとするとセキュリティの警告(ウィルス、セキュリティ上の危険性あり)が出てしまいました。
なるほど・・・。了解致しました。
もし、私があなたと同じ状況であれば、私も同じ判断を下すと思います。
マクロを実行しようとすると、マクロの内容がどのような簡単なものでも、必ずセキュリティの警告が出ます。
今回、警告が出されたのは、私が書いたマクロに問題があったからではないということは留意しておいてください。
No.5
- 回答日時:
とりあえず、sheet1のF欄に備考があり、そのデータもコピーするという前提で作成しました。
また、前回提示したものは、画面表示の抑止をしていませんでした。
大量のデータを処理する場合は画面表示の抑止を行ったほうが、処理時間の短縮が期待されるので、
抑止するように変えています。
上記の前提で良ければ、こちらのマクロを試してください。
-----------------------------------------------
Option Explicit
Public Sub Macro1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rowMax1 As Long 'sheet1最大行
Dim rowMax2 As Long 'sheet2最大行
Dim indexT As Object '社員番号をキーとする連想配列(行番号のインデックス)
Dim row1 As Long
Dim row2 As Long
Dim col2 As Long
Dim i, dt As Long
Dim sikakuT() As Long '資格数(キー:sheet2の行番号)
Dim maxsikaku As Long
Set indexT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
rowMax1 = sh1.Cells(Rows.Count, 1).End(xlUp).row 'sheet1の最大行取得
ReDim sikakuT(rowMax1)
'sheet2の全セルクリア(書式を含めてクリア)
sh2.Cells.Clear
rowMax2 = 1
maxsikaku = 1
Application.ScreenUpdating = False
For row1 = 2 To rowMax1
'社員番号が既に出現済みか
If indexT.exists(sh1.Cells(row1, 1).Value) = True Then
'出現済みならその社員のsheet2行番号を採用
row2 = indexT(sh1.Cells(row1, 1).Value)
Else
'新規ならそのsheet2行番号に1加算しそれを採用
rowMax2 = rowMax2 + 1
indexT(sh1.Cells(row1, 1).Value) = rowMax2
row2 = rowMax2
sikakuT(row2) = 0
End If
'その社員の資格数に1加算
sikakuT(row2) = sikakuT(row2) + 1
If sikakuT(row2) > maxsikaku Then
maxsikaku = sikakuT(row2) '資格数の最大を記憶
End If
'sheet2のカラム算出
col2 = (sikakuT(row2) - 1) * 5 + 2
If sikakuT(row2) = 1 Then
sh1.Cells(row1, 1).Copy '社員番号コピー
sh2.Cells(row2, 1).PasteSpecial
End If
For i = 0 To 4
sh1.Cells(row1, 2 + i).Copy '資格情報コピー
sh2.Cells(row2, col2 + i).PasteSpecial
Next
Next
'見出しコピー
sh1.Cells(1, 1).Copy
sh2.Cells(1, 1).PasteSpecial
For dt = 1 To maxsikaku
col2 = (dt - 1) * 5 + 2
For i = 0 To 4
sh1.Cells(1, 2 + i).Copy '資格情報コピー
sh2.Cells(1, col2 + i).PasteSpecial
Next
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox ("処理完了")
End Sub
------------------------------------------
もし、前提が異なる場合は、その旨、補足してください。
この回答へのお礼
お礼日時:2016/11/05 03:04
tatsu様
短時間において、丁寧に詳しく教えてくださりありがとうございました。
マクロ素人の私には使いこなす事が出来ず、せっかく用意していただいたのに本当に申し訳ありませんでした。
また機会がありましたら、よろしくお願いします。
No.4
- 回答日時:
>F列に備考欄を追加で設けていただけますでしょうか?
承知しました。
これは、sheet2のみの項目ですか。
もし、sheet1のF列に備考欄があれば、それもコピーします。
sheet1のF列に備考欄がなければ、sheet2は備考欄の見出しのみ作成し、内容は空白になります。
又、sheet1の行数は何行ほどありますか。
No.3
- 回答日時:
以下のマクロを標準モジュールへ登録してください。
-----------------------------------------------------------
Option Explicit
Public Sub Macro1()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim rowMax1 As Long 'sheet1最大行
Dim rowMax2 As Long 'sheet2最大行
Dim indexT As Object '社員番号をキーとする連想配列(行番号のインデックス)
Dim row1 As Long
Dim row2 As Long
Dim col2 As Long
Dim i, dt As Long
Dim sikakuT() As Long '資格数(キー:sheet2の行番号)
Dim maxsikaku As Long
Set indexT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set sh1 = Worksheets("sheet1")
Set sh2 = Worksheets("sheet2")
rowMax1 = sh1.Cells(Rows.Count, 1).End(xlUp).row 'sheet1の最大行取得
ReDim sikakuT(rowMax1)
'sheet2の全セルクリア(書式を含めてクリア)
sh2.Cells.Clear
rowMax2 = 1
maxsikaku = 1
For row1 = 2 To rowMax1
'社員番号が既に出現済みか
If indexT.exists(sh1.Cells(row1, 1).Value) = True Then
'出現済みならその社員のsheet2行番号を採用
row2 = indexT(sh1.Cells(row1, 1).Value)
Else
'新規ならそのsheet2行番号に1加算しそれを採用
rowMax2 = rowMax2 + 1
indexT(sh1.Cells(row1, 1).Value) = rowMax2
row2 = rowMax2
sikakuT(row2) = 0
End If
'その社員の資格数に1加算
sikakuT(row2) = sikakuT(row2) + 1
If sikakuT(row2) > maxsikaku Then
maxsikaku = sikakuT(row2) '資格数の最大を記憶
End If
'sheet2のカラム算出
col2 = (sikakuT(row2) - 1) * 4 + 2
If sikakuT(row2) = 1 Then
sh1.Cells(row1, 1).Copy '社員番号コピー
sh2.Cells(row2, 1).PasteSpecial
End If
For i = 0 To 3
sh1.Cells(row1, 2 + i).Copy '資格情報コピー
sh2.Cells(row2, col2 + i).PasteSpecial
Next
Next
'見出しコピー
sh1.Cells(1, 1).Copy
sh2.Cells(1, 1).PasteSpecial
For dt = 1 To maxsikaku
col2 = (dt - 1) * 4 + 2
For i = 0 To 3
sh1.Cells(1, 2 + i).Copy '資格情報コピー
sh2.Cells(1, col2 + i).PasteSpecial
Next
Next
Application.CutCopyMode = False
MsgBox ("処理完了")
End Sub
-----------------------------------------------
登録後、Macro1を実行してください。
sheet1の内容を読み込み、sheet2へまとめた結果を出力します。
sheet1,sheet2がある状態で実行してください。
不明点があれば、補足ください。
No.2
- 回答日時:
No1です。
>質問1 出来たらマクロ以外でお願いします。
マクロ以外ということは、excel関数でということでしょうか。
excel関数ということであれば、申し訳ありませんが提供できません。(私に提供できるスキルがありません)
excel関数の達人からの回答をお待ちいただけますでしょうか。
質問の回答により、要件が明確になりましたので
マクロでもよければ、マクロの提供は可能です。その場合は、その旨、補足ください。
No.1
- 回答日時:
補足要求です。
質問1:AJAXのカテゴリですが、excelのVBAのマクロの質問と理解して良いですか。
質問2:画像が小さくて良く見えません。
左側の図は
A列:社員番号
B列:資格名称
C列:資格No
D列:取得日
E列 :有効期限
であってますか。
また、上記の見出し行が1行あると理解してようですか。
質問3:並べ替えるのは別のシートへ並べかえて良いですか。
sheet1:元のデータ
sheet2:並べ替えたデータ
のようになります。sheet1,sheet2の名称についてはあなたがその名称を提示していただければ、その名称に従います。
質問4:並べ替える要件は、以下の通りで良いですか。
1.社員番号で1行にまとめる。
2.A列が社員番号とし、B列が資格名称、C列が資格No、 D列が取得日、E列が有効期限とする。
2つ以上の資格を持つ場合は、F列,G列,H列,I列に次の資格を割り当てる。(以降同様)
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) マクロ 2行ごとの並び替えについて 4 2022/12/14 12:27
- Excel(エクセル) 簡単なエクセルマクロについて 4 2023/02/20 10:22
- 保育士・幼稚園教諭 放課後児童支援員の資格を取りたいです。 私は現在26歳の男です。 仕事は、薬剤師としてドラッグストア 1 2023/05/17 17:14
- Excel(エクセル) 関数EXACT(文字列,文字列)とexcelVBA 3 2022/04/14 15:07
- YouTube youtubeのTOPページの動画紹介画面の並び方を変えたいです。 1 2023/03/18 09:25
- 介護福祉士・ケアマネージャー・社会福祉士 介護福祉士偽造され私の登録番号を複数人に使用された弊害はありますか? 1 2023/07/02 17:57
- Visual Basic(VBA) Excelで横書き50行の漢字テストデータを縦書きのテスト問題にしたい。 6 2022/04/27 15:03
- その他(ブラウザ) webサイトに表示する画像の向きを変える(左右に回す)方法 3 2023/01/20 08:28
- 弁護士・行政書士・司法書士・社会保険労務士 士業の有資格者などの表記 3 2023/01/10 18:59
- 会社設立・起業・開業 株式会社設立について。 ネットで調べても教えたがりさん達が難しい言葉を並べて意味が理解できないので教 2 2022/04/29 00:16
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
【VBA】条件に一致しない行を削...
-
テキストファイル読み込みにお...
-
エクセルで空白行を削除する ...
-
Excel VBAでオートフィルタで抽...
-
excel2021で実行できないマクロ...
-
VBAで保存しないで閉じると空の...
-
WPSOffice_マクロの有効化について
-
マクロの保存先、開いてるすべ...
-
Excelのマクロでボタンを押すと...
-
Excel マクロの編集がグレーに...
-
エクセル ボタンに設定したマク...
-
エクセルで、「いいね」のよう...
-
エクセルの表を複数枚印刷した...
-
エクセル関数>参照ファイル名...
-
複数のマクロボタンをまとめて...
-
エクセルのマクロ名に使えない...
-
強制的にマクロを有効にするVBA
-
リーグ戦(10チーム2コート)作...
-
VBA Shapes コピーと名前
-
コピーしたデータを2行ずつに貼...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
マクロで最終行を取得してコピ...
-
【VBA】条件に一致しない行を削...
-
エクセルで空白行を削除する ...
-
VB.net
-
エクセルのデータがない行には...
-
数値に見えるものはすべて数値...
-
【VBA】条件に一致しない行を削...
-
【マクロ】A列最終行までを、カ...
-
エクセルで階層図を作る方法
-
Excel VBAでオートフィルタで抽...
-
VBAでの重複データに色付け
-
Excel マクロ 検索結果を別シ...
-
Excel VBA オートフィルタの結...
-
各個体に対する平均値の自動計...
-
Access2003レポート:最終ペー...
-
EXCEL VBAでA列にある空白行よ...
-
Excelで、あるセルの値に応じて...
-
Excel97 指定した行だけマク...
-
エクセルのVBAで指定した行数の...
-
マクロにて指定の文字間の文字...
おすすめ情報
tatsu99
丁寧にありがとうございます。
質問1 出来たらマクロ以外でお願いします。
質問2 読み取りづらくすみません。
tatsuの読み通り、社員番号以下項目合っています。
質問3 別シートで問題ありせん。名称もtatsu様記載通りで良いです。
質問4 tatsu様のいうとおりの並びとしたいです。
お忙しい中、申し訳ありません。
お力をお借りできると大変助かります…。
tatsu様
返信ありがとうございます。
出来ましたら、関数でお願いしたいと思っていました。マクロはほぼ使った事がないもので…
でも、よろしければ教えていただけますか?
大変な作業をこの短時間に仕上げていただき、本当にありがとうございます。
今日の夜遅くか、明日にならないと試す事が出来ないのですが、使わせていただきます‼︎
ただ、申し訳ありません。
一つ項目を落としていました。
F列に備考欄を追加で設けていただけますでしょうか?
図々しくてすみません…
tatsu様
おはようございます。
昨日中に確認できずすみません。また、F列の件、しっかりとお伝えできておらず、すみません。
元データとなるsheet1において、備考欄が必要でした。
行数は400件弱となります。
抑止する等、色々考えて下さり、ありがとうございます。
まず、いただいた内容を持って会社で試してみたいと思います。
またご連絡させていただきます。
よろしくお願いします。
tatsu様
夜分遅くにすみません。
ご用意頂いたコードを標準モジュールに設定してみました。ただ、実行しようとするとセキュリティの警告(ウィルス、セキュリティ上の危険性あり)が出てしまいました。
私自身、マクロの初心者で内容の確認も出来ず、また、扱う情報に個人情報も含まれるため、これ以上、進める事が出来なくなりました。
tatsu様にはお力をお借しいただいたのに本当にすみません…