Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

53 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81420】Re:間違いを色であらわすことはできます...

γ - 20/7/26(日) 23:44 -


	引用なし

	パスワード

両者の不一致文字列を赤く着色するのではまずいですか？
山梨市　　山梨　　→　左の市だけを赤くする。

・ツリー全体表示


	【81419】間違いを色であらわすことはできますでし...

moro - 20/7/26(日) 17:52 -


	引用なし

	パスワード

こんにちは。質問ですが、
間違いを色で表すことはできますでしょうか？

Ａ列が正しく、Ｂ列が間違っているおり、Ｂ列の間違い
を表すもので、例えば、

Ａ列　　　　Ｂ列
山田　　　　山中　　　→　山中←”中”を赤色にする
田中　　　　田仲　　　→　田仲←”仲”を赤色にする
ゆうじ　　　ようじ　　→　ようじ←”よ”を赤色にする
山梨市　　　山梨　　　→　山梨←”市”を付け加えて赤色にする
間違い探し　町外探し　→　町外探し←”町外”を赤色にする

文字数が同じであったり、多かったりする分にはできないことは
ないのですが、少ない分に関してが難しく、何か良い知恵が
ありましたらよろしくお願いします。

・ツリー全体表示


	【81418】Re:表を加工して別ｼｰﾄに転記したい

マナ - 20/7/26(日) 17:40 -


	引用なし

	パスワード

▼ありすさん：

こんな書き方もできます
マクロで、Noを作成し、最後に削除しています。

>・最後に並べ替えをする際に、コードが被る事があるので、C列に並べ替え用Noを入れる項目を追加。

Option Explicit

Sub test()
　　Dim wsF As Worksheet, wsT As Worksheet
　　Dim 期間 As Long, 開始日 As Date
　　Dim 元データ As Range, データ数 As Long
　　Dim 貼付先 As Range
　　Dim k As Long, 月末 As Date
　　Dim 商品名 As Range, 数式 As String
　　Dim ソート範囲 As Range

　　Set wsF = Worksheets("Sheet1")
　　Set wsT = Worksheets("Sheet2")　'転記先
　　
　　期間 = wsF.Range("B5").Value
　　開始日 = wsF.Range("B6").Value
　　
　　Set 元データ = wsF.Range("C6", wsF.Range("K" & Rows.Count).End(xlUp))
　　元データ.Columns(1).Formula = "=row()"　　'並べ替え用No
　　データ数 = 元データ.Rows.Count
　　
　　Set 貼付先 = wsT.Range("C6")
　　　
　　For k = 1 To 期間
'　　'sheet1のデータをsheet2に貼り付け
　　　　元データ.Copy
　　　　貼付先.PasteSpecial xlPasteValues

　　　　'日付の入力
　　　　月末 = DateSerial(Year(開始日), Month(開始日) + k, 0)
　　　　貼付先.Resize(データ数).Columns(2).Value = 月末
　　　　
　　　　'商品名に日付を付加
　　　　Set 商品名 = 貼付先.Resize(データ数).Columns(7)
　　　　数式 = 商品名.Address & "&""" & Format(月末, "（'yy/m月分）") & """"
　　　　商品名.Value = 商品名.Worksheet.Evaluate(数式)
　　　　
　　　　Set 貼付先 = 貼付先.Offset(データ数)
　　Next
　　
　　'並べ替え
　　Set ソート範囲 = wsT.Range("C6", wsT.Range("K" & Rows.Count).End(xlUp))
　　ソート範囲.Sort ソート範囲.Columns(1)
　　
　　'並べ替え用Noの削除
　　ソート範囲.Columns(1).ClearContents
　　元データ.Columns(1).ClearContents
　　　　
End Sub

　

・ツリー全体表示


	【81417】Re:表を加工して別ｼｰﾄに転記したい

マナ - 20/7/26(日) 13:10 -


	引用なし

	パスワード

▼ありすさん：

修正してみました。

>　なぜか、データの項目名から取ってきてしまう場合が5回に1回くらい起こって>しまった。→未解決

>Sheet1.Range("C6:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy

Cells(Rows.Count, "E")の前にも、シート指定が必要です。

Sub tenki2()
　　Dim k As Long, g As Long 'k=期間　g=繰り返し用
　　Dim MaxRow1 As Long, MaxRow2 As Long
　　Dim kaishi As Date '開始日
　　Dim shuryo As Date '終了日
　　Dim h As Date '日付入力用
　　
　　'変数"k"に期間(何か月)をセット
　　k = Sheet1.Range("B5")
　　kaishi = Sheet1.Range("B6")
　　
　　For g = 1 To k
　　'sheet1のデータをsheet2に貼り付け
　　If Sheet2.Range("C6") = "" Then
　　　　MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　Sheet1.Range("C6:K" & Sheet1.Cells(Rows.Count, "E").End(xlUp).Row).Copy
　　　　Sheet2.Range("C6").PasteSpecial
　　　　MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
　　Else
　　　 MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　Sheet1.Range("C6:K" & Sheet1.Cells(Rows.Count, "E").End(xlUp).Row).Copy
　　　　Sheet2.Range("C" & MaxRow1).PasteSpecial
　　　　MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
　　End If
　　'日付の入力
　　h = DateSerial(Year(kaishi), Month(kaishi) + g, 0)
　　Sheet2.Range("D" & MaxRow1 & ":D" & MaxRow2).Value = h
　　Next
　　'並べ替え
　　With Sheet2.Sort
　　　　.SortFields.Clear
　　　　.SortFields.Add Key:=Sheet2.Range("C6")
　　　　.SortFields.Add Key:=Sheet2.Range("D6")
　　　　.SetRange Sheet2.Range("C5:K" & MaxRow2)
　　　　.Header = xlYes
　　　　.Apply
　　End With
　　
End Sub

・ツリー全体表示


	【81416】Re:表を加工して別ｼｰﾄに転記したい

ありす - 20/7/25(土) 23:47 -


	引用なし

	パスワード

▼マナさん：
▼マナさん
ご教示頂いた順序でマクロを書いてみました。
・最後に並べ替えをする際に、コードが被る事があるので、C列に並べ替え用Noを入れる項目を追加。
・並べ替えの書き方がわからなかったので、記録して範囲を最終行までに変更。
　→省けるコードなどがわからなかったので、そのままコピペしてしまった。
　もっとシンプルに書く方法などがありますか？
・データの量を増やして何度かテストしたのですが、
　なぜか、データの項目名から取ってきてしまう場合が5回に1回くらい起こってしまった。→未解決

書いたコードは以下の通りです。
添削とアドバイスがありましたらご教示頂きたく、よろしくお願いします。

Sub tenki()
Dim k As Long, g As Long 'k=期間　g=繰り返し用
Dim MaxRow1 As Long
Dim kaishi As Date '開始日
Dim shuryo As Date '終了日
Dim h As Date '日付入力用

'変数"k"に期間(何か月)をセット
k = Sheet1.Range("B5")
kaishi = Sheet1.Range("B6")
shuryo = Sheet1.Range("B7")

For g = 1 To k
　　'sheet1のデータをsheet2に貼り付け
　　If Sheet2.Range("C6") = "" Then
　　　　MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　Sheet1.Range("C6:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
　　　　Sheet2.Range("C6").PasteSpecial
　　　　MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
　　Else
　　　　MaxRow1 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row + 1
　　　　Sheet1.Range("C6:K" & Cells(Rows.Count, "E").End(xlUp).Row).Copy
　　　　Sheet2.Range("C" & MaxRow1 & "").PasteSpecial
　　　　MaxRow2 = Sheet2.Cells(Rows.Count, "C").End(xlUp).Row
　　End If
　　'日付の入力
　　h = DateSerial(Year(kaishi), Month(kaishi) + g, 0)
　　Sheet2.Range("D" & MaxRow1 & ":D" & MaxRow2 & "").Formula = h
Next
'並べ替え
　　ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("C6:C" & MaxRow2 & "") _
　　　　, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
　　ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("D6:D" & MaxRow2 & "") _
　　　　, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
　　With ActiveWorkbook.Worksheets("Sheet2").Sort
　　　　.SetRange Range("C5:K" & MaxRow2 & "")
　　　　.Header = xlYes
　　　　.MatchCase = False
　　　　.Orientation = xlTopToBottom
　　　　.SortMethod = xlPinYin
　　　　.Apply
　　End With
End Sub

・ツリー全体表示


	【81415】Re:表の比較

マナ - 20/7/24(金) 11:51 -


	引用なし

	パスワード

▼T-K さん：

dicYは、使う必要ありませんでした。

・ツリー全体表示


	【81414】Re:複数の値からある合計に一致するすべ...

マナ - 20/7/24(金) 11:24 -


	引用なし

	パスワード

▼ゆきぼさん：

>こちらのサイトは私も参考にして試してみたのですが
>動かないか、思うような答えが出ないかのどちらかでした。
>

わたしが試したのは、最後の回答者のコードだけですが
期待通りの結果になりましたが…

・ツリー全体表示


	【81413】Re:複数の値からある合計に一致するすべ...

ゆきぼ - 20/7/24(金) 11:03 -


	引用なし

	パスワード

▼マナさん：
>▼ゆきぼさん：
>
>検索してみました。
>ht　tps://teratail.com/questions/65795

マナ様
ご回答いただきありがとうございました。
こちらのサイトは私も参考にして試してみたのですが
動かないか、思うような答えが出ないかのどちらかでした。

お時間を取らせてしまい申し訳ありませんでした。

・ツリー全体表示


	【81412】Re:表の比較

マナ - 20/7/24(金) 11:03 -


	引用なし

	パスワード

▼T-K さん：

>最後にデータをエクセルシートに処理する際に
>繰り返し処理にて展開してますが一括での感じがわかりません

それだと、速度改善にならないと思います。
dictionaryでも、一括で書き込まないと同じです。

Sub test2()
　　Dim fSh As Worksheet
　　Dim tSh As Worksheet
　　Dim dicX As Object
　　Dim dicY As Object
　　Dim tbl As Range
　　Dim i As Long, k As Long
　　Dim dt As Double
　　Dim com As String
　　Dim mX, mY
　　Dim w
　
　　Application.ScreenUpdating = False
　
　　Set dicX = CreateObject("Scripting.Dictionary")
　　Set dicY = CreateObject("Scripting.Dictionary")

　　Set fSh = Sheets("Sheet1")
　　Set tSh = Sheets("Sheet2")
　
　　fSh.Cells.Interior.ColorIndex = xlNone
　　
　　Set tbl = tSh.Range("A1").CurrentRegion
　　w = tbl.Value
　
　　With fSh.Range("A1").CurrentRegion
　　　　For i = 2 To .Rows.Count
　　　　　　com = .Cells(i, "B").Value
　　　　　　If Not dicY.exists(com) Then
　　　　　　　　mY = Application.Match(com, tbl.Columns("B"), 0)
　　　　　　　　If IsError(mY) Then
　　　　　　　　　　.Rows(i).Interior.ColorIndex = 3
　　　　　　　　End If
　　　　　　　　dicY(com) = mY
　　　　　　End If
　　　　　　
　　　　　　If IsNumeric(dicY(com)) Then
　　　　　　　　For k = 3 To .Columns.Count
　　　　　　　　　　dt = .Cells(1, k).Value2
　　　　　　　　　　If Not dicX.exists(dt) Then
　　　　　　　　　　　　mX = Application.Match(dt, tbl.Rows(1), 0)
　　　　　　　　　　　　If IsError(mX) Then
　　　　　　　　　　　　　　.Columns(k).Interior.ColorIndex = 3
　　　　　　　　　　　　End If
　　　　　　　　　　　　dicX(dt) = mX
　　　　　　　　　　End If
　　　　　　　　　　　　
　　　　　　　　　　If IsNumeric(dicX(dt)) Then
　　　　　　　　　　　　w(dicY(com), dicX(dt)) = .Cells(i, k).Value
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　End If
　　　　Next
　　End With
　　
　　tbl.Value = w
　
　　MsgBox "転記完了"
　
End Sub

・ツリー全体表示


	【81410】Re:表の比較

T-K - 20/7/23(木) 23:51 -


	引用なし

	パスワード

とりあえず、すべて人任せのところがある為
わからないなりに自分で考えて作ってみました。(下記に載せました)
支離滅裂な感じですが、一応動きました。
データが増えた場合この処理ではどうなのかわからないですが・・・
最後にデータをエクセルシートに処理する際に
繰り返し処理にて展開してますが一括での感じがわかりません
やはりDictinaryのほうがシンプルに処理できそうなのでことらを
これからも使用します。今回はアドバイスいただきありがとうございました。

Sub 展開()

Dim myval0(), myval, myval1(), myval2(), myval3() 'データ入力用配列の宣言
Dim Myoutpt, Myoutpt1(), Myoutpt2(), Myoutpt0(), Myoutpt3() '出力用配列の宣言
Dim msg

Dim 品番1 As Range
Dim 品番2 As Range

'--------------------------------------------------------

Dim sh1 As Worksheet　'シート宣言

Dim sh As Worksheet

'-----------------------------------変数(Long型作成)　宣言

Dim a As Long
Dim b As Long
Dim d As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim l As Long
Dim m As Long
Dim n As Long

'---------------------------------------

Application.ScreenUpdating = False '画面停止処理

Set sh = Worksheets("データ取り込み")　'Sh＝データ取り込みシート

Set sh1 = Worksheets("集計")　'　Sh1=集計シート

'入力用配列の作成------------------------------------------------------------

myval = sh.Range("A1").CurrentRegion.Value 'データ取り込みシートのデータを配列に格納する
ReDim myval1(2 To UBound(myval, 1)) '配列要素数を設定する
For i = 2 To UBound(myval, 1)

myval1(i) = myval(i, 1) & myval(i, 2) '品番データを配列に格納する

Next

ReDim myval2(3 To (UBound(myval, 2) - 4)) '配列要素数を設定する

For n = 3 To (UBound(myval, 2) - 4) '納期データを配列に格納する
myval2(n) = myval(1, n)

Next

ReDim myval0(2 To UBound(myval, 1), 3 To (UBound(myval, 2) - 4)) '配列要素を設定

For a = 2 To UBound(myval, 1)
For b = 3 To UBound(myval, 2) - 4　'計画数をデータに確保する

myval0(a, b) = myval(a, b)

Next
Next

n = 2
d = 3
ReDim myval3(2 To UBound(myval1, 1), 3 To UBound(myval2, 1))　'配列要素数を設定する

For l = 2 To UBound(myval1, 1)　'すべての情報を配列に格納する
For m = 3 To UBound(myval2, 1)

myval3(l, m) = Split(myval1(l) & "_" & myval2(m) & "_" & myval0(n, d), "_") 'データを区切って連結させる

If d = UBound(myval0, 2) Then
n = n + 1
d = 3
If n = UBound(myval0, 1) Then

Exit For
End If

Else

d = d + 1

End If

Next
Next

'出力用配列作成--------------------------------------------

Myoutpt = sh1.Range("A1").CurrentRegion.Value 'データ取り込みシートのデータを配列に格納する
ReDim Myoutpt1(2 To UBound(Myoutpt, 1)) '配列要素数を設定する
For i = 2 To UBound(Myoutpt, 1)

Myoutpt1(i) = Myoutpt(i, 1) & Myoutpt(i, 2) '品番データを配列に格納する

Next

ReDim Myoutpt2(4 To (UBound(Myoutpt, 2)))　'配列要素数を設定する

For n = 4 To (UBound(Myoutpt, 2))　'納期データを配列に格納する
Myoutpt2(n) = Myoutpt(1, n)

Next

ReDim Myoutpt0(2 To UBound(Myoutpt, 1), 4 To UBound(Myoutpt, 2))　'配列要素を設定

For a = 2 To UBound(Myoutpt, 1)
For b = 4 To UBound(Myoutpt, 2)　'計画数をデータに確保する

Myoutpt0(a, b) = Myoutpt(a, b)

　Next
Next

ReDim Myoutpt3(2 To UBound(Myoutpt1, 1), 4 To UBound(Myoutpt2, 1))　'配列要素数を設定する

For l = 2 To UBound(Myoutpt1, 1)　'すべての情報を配列に格納する
For m = 4 To UBound(Myoutpt2, 1)

Myoutpt3(l, m) = Split(Myoutpt1(l) & "_" & Myoutpt2(m) & "_" & Myoutpt0(l, m), "_") 'データを区切って”＿”で連結させる

　　 Next
Next

For j = LBound(Myoutpt3, 1) To UBound(Myoutpt3, 1)
　　For i = LBound(Myoutpt3, 2) To UBound(Myoutpt3, 2)
　　　For k = LBound(myval3, 1) To UBound(myval3, 1)
　　　　For l = LBound(myval3, 2) To UBound(myval3, 2)
　　　　
　　　　
　　　　If j > UBound(myval3, 1) Then 'データ取り込みの品番に新規があり上限が増えた場合処理しない
　　　　Exit For
　　　　End If

　　If Myoutpt3(j, i)(0) & Myoutpt3(j, i)(1) = myval3(k, l)(0) & myval3(k, l)(1) Then　'品番＆納期の照合をして同じ場合値を取得
　　
　　
　　　　　　　 Myoutpt3(j, i)(2) = myval3(k, l)(2)
　　　　　　　
　　　　　　　
　　　　　　　 Else
　　　　　　　 Myoutpt3(j, i)(2) = Myoutpt3(j, i)(2)　'集計でーたにすでに値があり、今回取り込み対象外の場合集計のセルデータを登録

　　　End If

　　　　　　　　　Next
　　
　　　　　　　Next
　　　　　　　　　　　
　　　　　Next
　　 Next

'-------------------------------------------------------　集計シートに値を出力する

For i = 2 To UBound(Myoutpt3, 1)

　　　sh1.Cells(i, 3).Value = Myoutpt3(i, 4)(0)

Next

　 For i = 4 To UBound(Myoutpt3, 2)
　　　sh1.Cells(1, i).Value2 = Myoutpt3(2, i)(1)

　 Next

For m = LBound(Myoutpt3, 1) To UBound(Myoutpt3, 1)

　　　For n = LBound(Myoutpt3, 2) To UBound(Myoutpt3, 2)

　　　　　　　　 sh1.Cells(m, n) = Myoutpt3(m, n)(2)

　　 Next
Next

'----------------------------------------------------------------------集計シート品番とデータ取り込みシートのデータを照合して違う場合色で表示する

Set 品番1 = sh.Range("A1:A1000")
Set 品番2 = sh1.Range("A1:A1000")
'bも同じようにしてください。

'カウンタが1からセルの個数になるまで繰り返し処理
For i = 1 To 品番1.Cells.Count
　If 品番1.Cells(i).Value <> 品番2.Cells(i).Value Then

品番1.Cells(i).Interior.ColorIndex = 6

　End If
Next i 'この行に来たら「For ～」の行に勝手に戻

'-----------------------------------------------------------------------

Application.ScreenUpdating = True　'画面更新をOKにする

MsgBox "処理終了"

End Sub

・ツリー全体表示


	【81409】Re:複数の値からある合計に一致するすべ...

マナ - 20/7/23(木) 23:46 -


	引用なし

	パスワード

▼ゆきぼさん：

検索してみました。
ht　tps://teratail.com/questions/65795

・ツリー全体表示


	【81408】複数の値からある合計に一致するすべての...

ゆきぼ - 20/7/23(木) 19:00 -


	引用なし

	パスワード

初めまして。
よろしくお願い致します。

＜質問＞
I2～I22にランダムに値（数字）が入力されています。

　　I　　J　　K　　L　　M　　N　　O　　P
2　 1
3　 3
4　 5
5　 9
6　 12
・
・
・
22　35

例えば「I22」は35ですが、I2～I22までの値を足して「35」となる
組み合わせを「J22、K22、L22・・・」に表示させたいです。
かつ、表の上に希望の数字を入れるボックスと開始ボタンを付けたいです。

<EX>
J22 1+3+9+12　K22 3+5+9+・・・　L22 9+12+・・・

上記のようにすべての組み合わせを表示させたいのですが、
ソルバーではできず、自分なりにVBAを組んでみたのですが
初心者ということもあり、どの構文をどのようにして範囲をどこに
設定してよいかなどがわかりませんでした。

また、ボタンにVBAを登録はできるのですが、希望の数字を入力する
ボックスとそこに入力された数字をVBAに反映する方法も調べながら
やっては見たのですがうまく生きんせんでした。

丸投げのような形になってしまい、恐縮なのですがご存知の方が
いらっしゃいましたら、ご教授をお願い致します。

よろしくお願い致します。

・ツリー全体表示


	【81407】Re:表を加工して別ｼｰﾄに転記したい

ありす - 20/7/22(水) 21:45 -


	引用なし

	パスワード

▼マナさん：
並べ替えの件、最後にかいてありました。ごめんなさい。
2重に繰り返す方で途中まで書いてみてましたが、
最後に並べ替える方に方向転換して書いてみます。

>▼ありすさん：
>
>>これだと、私が最終的に作りたい形にはならないですが、
>>最後に並べ替えなどする感じになるでしょうか。
>
>はい。そう書きませんでしたか。
>
>>例はデータも期間も少なくしていましたが、
>>最終的な表は100行を余裕で超えるものになる場合が多いので、最後に並べ替えではなく、
>
>6行でも、1000行でも１回並べ替えるだけです。
>
>
>>１行目のデータを期間分の行にして、2行目に移る方法で考えていました。
>
>それでもよいですが、
>・元データの数だけ繰り返し
>・月数の数だけ繰り返し
>と２重に繰り返すことになって、複雑なマクロになりそうな気がしました。

・ツリー全体表示


	【81406】Re:表を加工して別ｼｰﾄに転記したい

マナ - 20/7/22(水) 21:02 -


	引用なし

	パスワード

▼ありすさん：

>これだと、私が最終的に作りたい形にはならないですが、
>最後に並べ替えなどする感じになるでしょうか。

はい。そう書きませんでしたか。

>例はデータも期間も少なくしていましたが、
>最終的な表は100行を余裕で超えるものになる場合が多いので、最後に並べ替えではなく、

6行でも、1000行でも１回並べ替えるだけです。

>１行目のデータを期間分の行にして、2行目に移る方法で考えていました。

それでもよいですが、
・元データの数だけ繰り返し
・月数の数だけ繰り返し
と２重に繰り返すことになって、複雑なマクロになりそうな気がしました。

・ツリー全体表示


	【81405】Re:表を加工して別ｼｰﾄに転記したい

ありす - 20/7/22(水) 14:52 -


	引用なし

	パスワード

▼マナさん：
これだと、私が最終的に作りたい形にはならないですが、
最後に並べ替えなどする感じになるでしょうか。
例はデータも期間も少なくしていましたが、
最終的な表は100行を余裕で超えるものになる場合が多いので、最後に並べ替えではなく、
１行目のデータを期間分の行にして、2行目に移る方法で考えていました。

そうすると、元データの行数分繰り返す。
sheet1の6行目(ｎ行目にしてデータの数分繰り返し）を貼り付け→ここで期間の月数分の行を作ってしまったほうがいい？
D列に最初の月から最後の月までの月末日を入力
→ここも月数分繰り返して月末日取得、入力
品名の後ろに('yy/mm月分）をくっつける。
→ここがどうしていいか想像がつかないです。
という流かなと思っています。

例で7月から10月としましたが、開始日、終了日はデータによってことなるので、
どうやって月をと月末日をだすのか悩んでました。

一旦、わからないながらにという感じになってしまいますが、
書いてみるので、添削＆アドバイス、引き続きいただけると嬉しいです。

後程、また書き込みします。
よろしくお願いします。

>▼ありすさん：
>
>こんな流れのマクロです
>
>１）sheet1のE6:K7を、sheet2のE6にコピー
>２）sheet2のD6:D7に、"2020/7/31"を入力
>３）sheet2のI6:I7の値に、"('20/7月分)"を付加
>４）sheet1のE6:K7を、sheet2のE8にコピー
>５）sheet2のD8:D9に、"2020/8/31"を入力
>６）sheet2のI8:I9の値に、"('20/8月分)"を付加
>７）sheet1のE6:K7を、sheet2のE10にコピー
>８）sheet2のD10:D11に、"2020/9/30"を入力
>９）sheet2のI10:I11の値に、"('20/9月分)"を付加
>10）G列で並び替え

・ツリー全体表示


	【81404】Re:表を加工して別ｼｰﾄに転記したい

ありす - 20/7/22(水) 14:28 -


	引用なし

	パスワード

マナさん

ありがとうございます！
いただいた流れで、書いてみて、こちらに転記してみます。
今、別の仕事が立て込んでしまって、お返事が遅くなってしまいました。

時間を見て、一度書いてみます。

・ツリー全体表示


	【81403】Re:表を加工して別ｼｰﾄに転記したい

マナ - 20/7/21(火) 21:53 -


	引用なし

	パスワード

▼ありすさん：

こんな流れのマクロです

１）sheet1のE6:K7を、sheet2のE6にコピー
２）sheet2のD6:D7に、"2020/7/31"を入力
３）sheet2のI6:I7の値に、"('20/7月分)"を付加
４）sheet1のE6:K7を、sheet2のE8にコピー
５）sheet2のD8:D9に、"2020/8/31"を入力
６）sheet2のI8:I9の値に、"('20/8月分)"を付加
７）sheet1のE6:K7を、sheet2のE10にコピー
８）sheet2のD10:D11に、"2020/9/30"を入力
９）sheet2のI10:I11の値に、"('20/9月分)"を付加
10）G列で並び替え

・ツリー全体表示


	【81402】Re:表を加工して別ｼｰﾄに転記したい

マナ - 20/7/21(火) 21:18 -


	引用なし

	パスワード

▼ありすさん：

>繰り返してn回転記するというのはわかるのですが、
>そこに、日付の操作と、品名の後ろにつける方法がわかりません。

わからないところは、こちらで考えますので
できるところだけでも自分で書いてみませんか。

・ツリー全体表示


	【81401】表を加工して別ｼｰﾄに転記したい

ありす - 20/7/21(火) 15:50 -


	引用なし

	パスワード

はじめまして。
過去ログを検索してみたものの、似てるのはあったけど自分で応用ができず投稿させていただきます。
無知ですみません。
今、手作業と関数を使ってやっている作業を自動でできたらいいな。と思って検索していました。

やりたいことは、以下です。
・sheet1にある表をsheet2に転記したい。
・sheet1に開始日と終了日の項目があるので、それをsheet2に転記するときに品名の後ろにくっつけたい

sheet1のデータ
セルD5からセルK5までは項目名が入っていて、
セルD6からセルK○行目までデータが入っています。
A列とB列に必要情報が色々書いてあって、その中に、開始日と終了日があります。
期間→B5　B6とB7の日付から何か月分か計算してある。
開始日→B6
終了日→B7
D5日付　E5発送1　F5発送2　G5発送コード1　H発送コード2　I5品名　J5金額　K5金額2

日付は開始から終了の各月の月末日付を入力
発送1、発送2、発送コード1、発送コード2、金額、金額2はそのまま転記
品名は、品名の後ろに（'20/1月分）など日付と同じ月をカッコで追加。

Sheet1のデータ1行に対して、開始日(月)から終了日(月)までを繰り返して、
最終行まで転記したい。

sheet1のデータは、その時によって変動しデータ行数は固定ではありません。
（データの始まりは6行目で固定）
期間→B5　3か月
開始日→B6　2020/7/10
終了日→B7　2020/9/10
D　　　　　E　　　　F　　　G　　H　　I 　　　J　　K
2020/7/10　東京都　××区　001　123　りんご　100　100
2020/7/10　千葉県　△△市　002　456　みかん　200　0

sheet2に転記したとき(項目名が5行目にあるので、データ開始はD6から）
D　　　　　E　　　　F　　　G　　H　　I 　　　　　　　　　J　　K
2020/7/31　東京都　××区　001　123　りんご('20/7月分)　100　100
2020/8/31　東京都　××区　001　123　りんご('20/8月分)　100　100
2020/9/30　東京都　××区　001　123　りんご('20/9月分)　100　100
2020/7/31　千葉県　△△市　002　456　みかん('20/7月分)　200　0
2020/8/31　千葉県　△△市　002　456　みかん('20/8月分)　200　0
2020/9/30　千葉県　△△市　002　456　みかん('20/9月分)　200　0

繰り返してn回転記するというのはわかるのですが、
そこに、日付の操作と、品名の後ろにつける方法がわかりません。

よろしくおねがいします。

・ツリー全体表示


	【81400】Re:表の比較

マナ - 20/7/16(木) 21:05 -


	引用なし

	パスワード

▼T-K さん：

>配列を表に入れるこのプログラムは、教えていただいた
>ものです。私が作成したものではありません。

それは、承知しています。
dictionaryで何をしているか理解できてなさそうだったので
根のため確認しました。

>処理速度が遅いようであれば、現状と変わらないため参考までとさせていただきます。Matchで照合しているようですが、少しむずかしいです。
>とりあえず調べてみます。

処理速度は考えていません。
あくまで配列の勉強です。
↓こういうことでしたので。

>一番の理由は、配列を理解するため。

速度重視なら、dictionaryの使い方を変更し
配列から、一括で、sheet2に書き込むようにすると
少しは速くなるはずです。

ただし、トライするのは、もっと単純なケースでよいので
dictionaryと配列を使えるようになってからが良いと思います。

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

53 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free