![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?a65a0e2)
こんにちは。
仕事で伝票を管理しているエクセルデータを管理ソフトに一括でインポートするため、管理ソフト用のデータ作成をしようとしています。
図のように伝票番号ごとに(色分けごとが1枚の伝票)管理しています。
これを管理ソフトインストール用にするには、1枚の伝票に使用した「桁数」が必要で、更に伝票の最後に1行増え、品名の欄に「伝票番号」がきます。
関数で何とかしようとやり始めましたが、お手上げになりました。
伝票の枚数が多いので、時間短縮できるよう、やり方を教えてくださる方のお力をお借りできるとありがたいです。
お手数をおかけしますが、よろしくお願いいたします。
![「エクセルデータをシステムインポートデータ」の質問画像](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/7/542533480_59252dc845565/M.jpg)
No.9ベストアンサー
- 回答日時:
① 注意:対応表がないと、このマクロは動きません。
Sub ChangeFormatsTIO()
'すでに伝票番号はソートが終わっているものとします。
Dim LastRow As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim shTio As Worksheet
Dim out_Order, out_O
Dim out_title, Ttl
Dim i As Long, k, j As Long
Dim Keta As Long
Dim Dnp As Long
Dim Out_dnp As Variant
'********設定項目*******
'シート名
Set sh1 = Worksheets("Sheet1") '元のデータ
Set sh2 = Worksheets("Sheet2") '排出されるデータ
Set shTio = Worksheets("対応表1")
'出力の項目の取得
With shTio
out_title = .Range("C2", .Cells(Rows.Count, 3).End(xlUp)).Value
Ttl = Application.Transpose(out_title)
out_Order = .Range("B2", .Cells(Rows.Count, 2).End(xlUp)).Value '順番リスト
out_Order = Application.Transpose(out_Order)
For Each c In .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
If c.Column = 2 Then
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If Not IsNumeric(c.Offset(i).Value) Then
Dnp = i '伝票番号出力位置
Exit For
End If
Next
ElseIf c.Value Like "*出力*" Then
For i = 1 To .Cells(Rows.Count, 3).End(xlUp).Row 'C列
If c.Offset(i).Value <> "" Then
Out_dnp = i '伝票番号出力位置
Exit For
End If
Next
ElseIf c.Value Like "桁*" Then
For i = 1 To .Cells(Rows.Count, 3).End(xlUp).Row 'C列
If c.Offset(i).Value <> "" Then
Keta = i '桁番号
Exit For
End If
Next
End If
Next
End With
i = 1
y = 2
With sh1
col = .Range("A1", .Cells(1, Columns.Count).End(xlToLeft)).Columns.Count
Data1 = .Range("A1", .Cells(Rows.Count, 1).End(xlUp).Resize(, col).Offset(1)).Value
End With
With sh2
'前の転送済のデータの消去
.Range("A1").CurrentRegion.ClearContents
.Range("A1").Resize(, UBound(Ttl)).Value = Ttl
Do
i = i + 1
j = 1
For Each k In out_Order
If IsNumeric(k) And Not IsEmpty(k) Then
.Cells(i, k).Value = Data1(y, j)
ElseIf VarType(k) = vbString Then
cnt = cnt + 1
.Cells(i, Keta).Value = cnt
End If
j = j + 1
Next k
If Data1(y + 1, Dnp) <> Data1(y, Dnp) And i > 2 Then
i = i + 1
j = 1
'桁番号
cnt = cnt + 1
For Each k In out_Order
If IsNumeric(k) And Not IsEmpty(k) Then
If k < Out_dnp Then
.Cells(i, k).Value = Data1(y, j) '日付
ElseIf k > Out_dnp Then
.Cells(i, k).Value = 0
End If
Else
.Cells(i, Keta).Value = cnt
End If
j = j + 1
Next
.Cells(i, Out_dnp).Value = Data1(y, Dnp) '伝票番号
cnt = 0
End If
y = y + 1
DoEvents
Loop Until y = UBound(Data1)
End With
End Sub
'
No.12
- 回答日時:
こんにちは。
今回は、偶然が重なったにすぎないと思いますが、ちょっと難しい話を残しておきます。
それは、会社の中で偉い人になった時に、いえ、もう直面しているかもしれませんが、
『日本版SOX法』という企業内の実務で使われるExcelなどの使用手順などの統制のことです。『Excelレガシー』といって、担当者がいなくなると、とたんに表計算ソフトが使えなくなって、事業に支障を来すことになる問題です。
特に、担当者だけが分かっている独特のメソッドなどが災いするそうです。まして、今、Excel自体も過渡期にあるようで、人知れず使えなくなっている機能もあったりします。そこにマクロの内容が関わってしまうと、専門の人しか直せません。
今回、ある程度、汎用性を高めることを念頭には入れて作りましたが、このように図に当るというのは、みけみけ丸さんの理解あっての賜物に違いありません。
ただ、今回のマクロについては、本当は、半年後とかに、もう一度精査したほうがよいかもしれません。会社で使うマクロは、月度末、年度末を経て信頼のおけるツールに変わります。
私としては、できるだけ、Sheet1側の項目の順序とSheet2側の項目の順序の間は飛んでも、順序は逆にならない方が安定して処理できると思います。
以下は、専門業者のページですが、『Excelレガシー問題』に対して、とても参考にしています。
5.Excel(エクセル)レガシー問題
http://www.ai-light.com/access/gigyho_access_leg …
何か、私としても、気持ちの良い終わり方ができそうな気がします。
私の方からも、お礼を申し上げます。
レガシー問題ですかぁ。
そういわれてみれば、バージョンアップしたら作成したマクロが使えなくなったりしていることがありました。
業務データが適切に管理・活用出来なくなり、かえってデータ管理上のリスクになってしまうなんて。
せっかく効率化を図ろうと思って作成したものが、かえってリスクになる可能性はありますね。
そのためにも、どういう成り立ちでできているかの説明は残したほうがいいですね。
細かいところまで気配りいただきまして、ありがとうございます。
感謝いたします。
ところで、完璧につくっていただいたと思っていたデータでしたが、私の見落としで、まだ完全ではありませんでした・・・
別に質問をさせていただくことになると思いますので、見つけてくださって、お仕事に支障がないようでしたら、また教えてくださいね。
今回は、ありがとうございました。
No.11
- 回答日時:
ご指摘の部分は、もともと、手元のコードでは「?」のついていたところで、どうするか反応を危ぶんでいた部分です。
ただ、それは、伝票番号と桁番号の間ということと、その間のSheet1 の順番が逆順になっている部分がありませんから、特に問題はないと思います。'桁番号
cnt = cnt + 1
For Each k In out_Order
If IsNumeric(k) And Not IsEmpty(k) Then
If k < Out_dnp Then
.Cells(i, k).Value = Data1(y, j) '日付
'-----------------------------'以下2行の訂正
ElseIf k > Out_dnp And Keta > k Then
.Cells(i, k).Value = Data1(y, j)
End If
Else
.Cells(i, Keta).Value = cnt
End If
j = j + 1
Next
'------------------
ElseIf k > Out_dnp And Keta > k Then
伝票番号より大きく、桁番号よりも小さい間という意味
しかし、明細区分の後がどのようになっているのが良いのか、分かっていません。
こういうことも考えられます。
'桁番号
cnt = cnt + 1
For Each k In out_Order
If IsNumeric(k) And Not IsEmpty(k) Then
If k < Out_dnp Then
.Cells(i, k).Value = Data1(y, j) '日付
ElseIf k > Out_dnp And Keta > k Then
.Cells(i, k).Value = Data1(y, j)
ElseIf k > Keta Then
.Cells(i, k).Value = 0 '0を入れる
End If
Else
.Cells(i, Keta).Value = cnt
End If
j = j + 1
Next
そのループの中で処理した方が収まるとは思うものの、もしかしたら、その塊全体を直したほうがよいのかもしれません。
それにしても、今回、詳しい説明をしていませんでしたが、仕様変更にもかかわらず、よく設定・実行ができたことに、かなり驚きました。実は、半信半疑だったのです。このレベルになると設定が分からないという人も出てきます。
なお、
>これが最後だと思いますので、
すでに私自身が、ここで書き込み自体を4月の末で一旦終えようと思いつつ、6月まで来るとは思っていませんでした。もう一度、原点に戻って充電しないといけないものがあるように思っています。
WindFallerさま
いつも丁寧に教えてくださり、本当に感謝です。
明日、会社で試してみます。今から楽しみです♪
WindFallerさまのお陰で、時間をかけて人力が行っていた作業から解放されそうです。
お忙しいのに親身になっていただき、本当にありがとうございます。
4月末で引退(?)をお考えだったようで…私はその前にお世話になることができてラッキーでした(^^)
明日、会社から書き込みさせていただきます!
ありがとうございました。
No.10
- 回答日時:
最初に、これはβ版で完成ではありませんが、こちらでは試してもらいながら、修正を加えたいと考えています。
実行ファイルは ChangeFormatsTIOです。
最初に、
#9のコードの
Set shTio = Worksheets("対応表1")
は複数の対応表になった時のものですから、
Set shTio = Worksheets("対応表") ←1 を取る
にしてください。
今回、二つの条件を、対応表を書き換えれば、以下のマクロで共有できます。
対応表の書き方は、#8の図を利用してください。
◎使用説明書
(転記マクロ・ベータ版)2017/ 5/30
まず、対応表を作成するマクロを実行してください。
転記する側(Sheet1), 転機される側(Sheet2)で、
転機される側(Sheet2)が全体のフォーマットの基盤になります。
転機される側のSheet2 の順番(4列目-D列)を元にして、
転記する側(Sheet1)の貼り付け場所を決めていきます。
伝票に当たるところは、「x」を入れます。
注意:対応表のタイトル行、伝票番号・桁番号などは、なるべく他に替えないでください。変える場合は、キーワードを残す必要があります。
伝票番号出力(5列目-E列)は、「x(任意)」を必ず一つ入れてください。Sheet2 の任意の場所に出力可能ですが、日付の場所には、入れないでください。
桁番号(6列目-F列)は、桁(伝票のアイテム番号)で、「k(任意)」を入れてください。
日付は選ばないことと、桁(アイテム番号)を出力するので、それ以外なら、選ぶことが可能です。
----------------------
'②
'MakeTaiohyoで、対応表をまず先に作成してください。
Sub MakeTaiohyo()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim shTio As Worksheet
Dim shName As String
Dim i As Long
Dim Ttl As String, Ttls As Variant
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Ttl = "Sheet1,貼付位置,Sheet2,順番,伝番出力,桁番号"
Ttls = Split(Ttl, ",")
On Error GoTo ErrHandler
'シート追加
If MsgBox("シートを新たに作りますか?", vbOKCancel) = vbCancel Then Exit Sub
Worksheets.Add After:=Worksheets(Worksheets.Count)
Set shTio = ActiveSheet
shName = "対応表"
shTio.Name = shName 'シート名の変更
With shTio
With .Range("A1").Resize(, UBound(Ttls) + 1)
.Value = Ttls
.Borders.LineStyle = xlContinuous
.EntireRow.AutoFit
.HorizontalAlignment = xlCenter
End With
sh1.Range("A1", sh1.Cells(1, Columns.Count).End(xlToLeft)).Copy
.Range("A2").PasteSpecial xlPasteAll, , , True
With .Range("A2", .Cells(Rows.Count, 1).End(xlUp))
.Resize(, 2).Borders.LineStyle = xlContinuous
End With
sh2.Range("A1", sh2.Cells(1, Columns.Count).End(xlToLeft)).Copy
.Range("C2").PasteSpecial xlPasteAll, , , True
With .Range("C2", .Cells(Rows.Count, 3).End(xlUp))
On Error Resume Next
.Find("日付").Interior.ColorIndex = 6
On Error GoTo 0
.Offset(, 1).FormulaLocal = "=ROW(R[-1]C)"
.Value = .Value
.Resize(, 4).Borders.LineStyle = xlContinuous
.CurrentRegion.HorizontalAlignment = xlCenter
End With
End With
Exit Sub
ErrHandler:
If Err.Number <> 0 Then
i = i + 1
shName = "対応表"
shName = shName & i
If i > 10 Then Exit Sub '対応表は10個まで
Resume
Else
Exit Sub
End If
End Sub
No.8
- 回答日時:
おそくなってすみません。
もともと、設計図というか、フローチャートもなく頭の中で考えたもので、それで通用すると思ったら、ものの見事に失敗しました。フレキシブルに対応できるような、誰にでも可能なような「対応表」から転記できるように作り変えています。もう少しお時間ください。
その「対応表」とは、以下のようなものを考えています。
最初の質問のものでも、後の質問のものでも、入力の数字や文字を入れればできるようにします。
![「エクセルデータをシステムインポートデータ」の回答画像8](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/c/1138040_592c348039753/M.jpg)
No.7
- 回答日時:
一応、報告だけ。
何度もやり直していますが、すみません、次に続かないのです。今のとろこ、追加に出された注文自体は、ほとんど理解していません。
しかし、ユーザーの任意の数字の記入で、転記が一対一の対応になるように、番号を代入する方式にすれば後はなんとかなると思い、全面的にやり直ししようとしましたが、逆に堂々巡りに入ってしまいました。
なお前回の桁番号に当たる部分はどこなのでしょうか?行番号でしょうか。
画像を見てください。
![「エクセルデータをシステムインポートデータ」の回答画像7](http://oshiete.xgoo.jp/_/bucket/oshietegoo/images/media/9/1138040_592997b3a9e4e/M.jpg)
何度もやり直しをしながら作成をしてくださっているようで、本当に有り難く何とお礼を申し上げたらよいかわからない程、感謝しております。
ありがとうございます。
以前の質問内容と記述が異なり、紛らわしくて申し訳ありません。
桁番号は、Sheet1には存在しておらず、Sheet2では"行番号"にあたります。
Sheet1の”相手先出荷番号”が質問した「商品名」の下にくる「伝票番号」です。
ですので以前の質問の「伝票番号」⇒「相手先出荷番号」です。
以前の質問の「品名」⇒「商品名」となります。
こんな面倒なことをお願いし、申し訳ありません。
どうぞ、よろしくお願いいたします。
No.6
- 回答日時:
こんにちは。
何か、私のいつものパターンと違うので、面食らっています。(^^;
いつもは、9割以上のダメ出しだからです。久々、何年ぶりでしょうか?
その理由は、私のコードは、かならず配列を使用するからです。
---
・項目を増やす件
なるべくコード自体をいじらないで、設定できないか工夫してみました。
------
一例として、出力項目に備考を加えました。
項目設定の部分だけで、全てが設定が終わるはずですが、試してみていただけますか?
設定項目を書き加えてみた例です。
ほかはいじる必要がありません。(そのつもりです)
'********設定項目*******
'シート名
Set sh1 = Worksheets("Sheet1") '元のデータ
Set sh2 = Worksheets("Sheet2") '排出されるデータ
'出力の項目
Const OUT_titles As String = "日付,桁番号,品番,品名,個数,金額,備考" '(1)
'項目はどの順番で入るか?
''日付(1),(伝票番号->桁番号),品番(3),金額(4),個数(5),品名(6),備考(7)
out_Order = Array(1, 2, 3, 6, 5, 4, 7) '(2)
'*****************
'---------------------
'// 実際のコード
Sub ChangeFormatsFlx()
'すでに伝票番号はソートが終わっているものとします。
Dim LastRow As Long
Dim x As Long, y As Long
Dim arr_in()
Dim n As Long, i As Long, j As Long, k As Variant, m As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim out_Order As Variant
Dim b_num As Long 'ボーナス番号
'********設定項目*******
'シート名
Set sh1 = Worksheets("Sheet1") '元のデータ '*
Set sh2 = Worksheets("Sheet2") '排出されるデータ '*
'出力の項目
Const out_titles As String = "日付,桁番号,品番,品名,個数,金額" '*
''項目はどの順番で入るか?
''日付(1),(伝票番号>桁番号),品番(3),金額(4),個数(5),品名(6)
out_Order = Array(1, 2, 3, 6, 5, 4) '*
'*****************
'項目数のチェック
If UBound(Split(out_titles, ",")) <> UBound(out_Order) Then
MsgBox "項目の順番のコマ数に過不足があります。", vbExclamation
Exit Sub
End If
b_num = UBound(Split(out_titles, ",")) + 2 'ボーナス番号代入
'使用する変数の初期化
j = 1
n = 1
m = 0
With sh1
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr_in(1 To LastRow + 1, 1 To b_num)
For i = 2 To LastRow
For Each k In out_Order
If k = 2 Then
m = m + 1
arr_in(j, n) = m
Else
arr_in(j, n) = .Cells(i, k).Value
End If
n = n + 1
If n > (b_num - 1) Then '1行の終わり
arr_in(j, b_num) = .Cells(i, 2).Value
n = 1
j = j + 1
Exit For
End If
Next
'★伝票番号が変われば、mは、0にする
If Trim(.Cells(i + 1, 2).Value) <> Trim(.Cells(i, 2).Value) Then m = 0
Next
End With
'データの吐き出し
With sh2
x = 2 '開始行
y = 1 '開始列
.Activate
.UsedRange.ClearContents
'タイトル行
With .Range("A1").Resize(, b_num - 1)
.Value = Split(out_titles, ",")
.HorizontalAlignment = xlCenter
End With
For i = 1 To UBound(arr_in) - 1
For j = 1 To UBound(arr_in, 2) - 1
.Cells(x, y).Value = arr_in(i, j)
y = y + 1
Next
y = 1
'挿入行
If arr_in(i + 1, b_num) <> arr_in(i, b_num) Then '伝票番号出力
x = x + 1
For j = 1 To UBound(arr_in, 2) - 1
If j = 1 Then
.Cells(x, y).Value = arr_in(i, j)
ElseIf j = 2 Then
.Cells(x, y).Value = arr_in(i, j) + 1
ElseIf j = 4 Then
.Cells(x, y).Value = arr_in(i, b_num)
ElseIf j > 4 Then
.Cells(x, y).Value = 0 '0 出力
End If
y = y + 1
Next
y = 1
End If
x = x + 1
Next
End With
End Sub
こんにちは。
ご親切に教えていただき、本当に感謝です。
魔法のような、このマクロを教えていただいたので、ぜひ確実に使いこなせるようになりたいと思っております。
そこで、質問させてください。
①Sheet1(元データ)は9項目
Sheet2(管理ソフト一括インポート用変換データ)は53項目あります。
②Sheet1にあってもSheet2に不要な項目が5項目あります。
(必要なのは9項目のうち4項目のみ)
この状態でも、教えていただいたマクロは使えますか?
MsgBox "項目の順番のコマ数に過不足があります。"
とあったので、項目数が同じでないと動かないのでは?と思いお聞きしました。
Sheet2(管理ソフト一括インポート用変換データ)は必ず「1」や「0」などを立てる項目があり、空白欄も多くあります。
それは関数でやろうと思っております。
本当は、全てマクロで変換できるように教えていただきたいのですが・・・(^_^;)
本当にわがまま言って申し訳ありませんが、ここまで、考えていただいたので、完全に使えるようにご指導よろしくお願いいたします。
No.5
- 回答日時:
>日付けの順番もバラバラなので「伝票番号」だけが区切りになります
そうでしたね。伝票番号で区切るのでした。
ちょっと他に気がそがれることがいろいろあって、うっかりしてしまいました。
こんな時には、マクロコードも何か変なところがあるかもしれません。
業務で使われるマクロコードは、もう少しわかりやく書かなくてはならないはずですが、今は手抜きです。検討する余地ありです。
'//
Sub ChangeFormats()
'すでに伝票番号はソートが終わっているものとします。
Dim LastRow As Long
Dim x As Long, y As Long
Dim arr_in()
Dim n As Long, i As Long, j As Long, k As Variant, m As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
'****設定部分**********登録してください
Set sh1 = Worksheets("Sheet1") '元のデータ
Set sh2 = Worksheets("Sheet2") '排出されるデータ
'*****************
'使用する変数の初期化
j = 1
n = 1
m = 0
With sh1
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
ReDim arr_in(1 To LastRow + 1, 1 To 7)
For i = 2 To LastRow
For Each k In Array(1, 2, 3, 6, 5, 4) '項目の順序
If k = 2 Then
m = m + 1
arr_in(j, n) = m
Else
arr_in(j, n) = .Cells(i, k).Value
End If
n = n + 1
If k = 4 Then '1行の終わり
arr_in(j, 7) = .Cells(i, 2).Value
n = 1
j = j + 1
Exit For
End If
Next
'伝票番号が変われば、m<カウント>は、0にする
If Trim(.Cells(i + 1, 2).Value) <> Trim(.Cells(i, 2).Value) Then m = 0
Next
End With
'データの吐き出し
With sh2
x = 2 '開始行
y = 1 '開始列
.Activate
.UsedRange.ClearContents
'タイトル行
With .Range("A1:F1")
.Value = Array("日付", "桁番号", "品番", "品名", "個数", "金額")
.HorizontalAlignment = xlCenter
End With
For i = 1 To UBound(arr_in) - 1
For j = 1 To UBound(arr_in, 2) - 1
.Cells(x, y).Value = arr_in(i, j)
y = y + 1
Next
y = 1
'挿入行
If arr_in(i + 1, 7) <> arr_in(i, 7) Then
x = x + 1
For j = 1 To UBound(arr_in, 2) - 1
If j = 1 Then
.Cells(x, y).Value = arr_in(i, j)
ElseIf j = 2 Then
.Cells(x, y).Value = arr_in(i, j) + 1
ElseIf j = 4 Then
.Cells(x, y).Value = arr_in(i, 7)
ElseIf j > 4 Then
.Cells(x, y).Value = 0
End If
y = y + 1
Next
y = 1
End If
x = x + 1
Next
End With
End Sub
![](http://oshiete.xgoo.jp/images/v2/common/profile/M/noimageicon_setting_14.png?a65a0e2)
No.4
- 回答日時:
以下の前提条件でマクロを作成して良いですか。
1)元のデータのシート名はSheet1
2)出力元のデータのシート名はSheet2
3) 一番左側の日付はA列である。(Sheet1,Sheet2共通)
4)Sheet1,Sheet2共に1行目は見出しである。
5)Sheet2は2行目から出力する。(マクロで見出しは作成しない)
6)同じ伝票は、連続した行に格納されている。
例 以下のようなケースはない
10行 伝票番号=111-222
11行 伝票番号=111-888
12行 伝票番号=111-222
質問の意図はSheet1の伝票番号が前行と変わった時、Sheet2へ前行の伝票番号を出力するが、
それで良いでしょうかという意味です。
もし、上記の例のようなケースがあると、111-222の番号が品名として2回出力されます。
No.3
- 回答日時:
私は、マクロで考えてみたのですが、分からない所があります。
それは、区分けは、品番の999で以って、切り分けるような気がしましたが、必ずしもそうではないようで、まさか、塗りつぶしの色ですか?
それとも、別に何かあるのですか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(データベース) 伝票番号、品番、在庫としてマクロでもAccessでもデータ表を作りたいのですが、ご指導お願いします 1 2022/11/13 23:48
- メルカリ らくらくメルカリ便でクロネコヤマトを使って商品を送ってもらいましたが数日経っても伝票未登録のままです 1 2022/09/29 19:56
- Java Java 配列<選挙> 4 2023/07/31 15:07
- その他(ビジネス・キャリア) 正社員と同じ内容のしごとでなければ契約社員はかんたんに雇い止めできるの??? 6 2023/01/14 17:31
- Visual Basic(VBA) EXCEL関数LOOKUPとFILTERについての質問です 1 2022/12/21 05:53
- その他(パソコン・スマホ・電化製品) エクセル初心者です。 仕事でエクセルを使っていて、普段は素人でもできる簡単な関数を使ったことがある程 1 2022/05/25 11:17
- Excel(エクセル) エクセルで納品書(入伝票)を作成 7 2022/04/14 10:15
- Visual Basic(VBA) VBAコードが作動せず、どこに問題があるのか教えて下さい。 3 2023/06/13 13:20
- その他(ソフトウェア) 現在と過去の顧客名簿、新規・解約・更新など作りたいのですが「やよいの顧客管理」なら簡単に扱えますか? 1 2022/05/18 10:44
- 分譲マンション 総会前にきて、管理会社のフロントマンに振り回され役員一同が困っています。 5 2023/05/15 03:12
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Accessフォームのボタンの二度...
-
弥生会計11 現金出納帳 並び替え
-
エクセルでシリアリナンバーを...
-
勘定奉行での伝票の追加方法
-
アクセスのパラメータに既定値...
-
エクセルにて伝票番号ごとに小...
-
Excel VBAについて
-
何か言い方ある?「毎月最終水...
-
数量・会社ごとに異なる単価表...
-
弥生会計って酷くないですか?
-
弥生会計と、マネーフォワード...
-
「弥生・会計」の導入に関して...
-
総合振込形式のFBデータが作成...
-
弥生販売14pro のテーブル構成...
-
PCA商魂 エクスポートについて
-
弥生販売08の親機と子機を入れ...
-
Quickbooks
-
弥生販売と弥生会計のソフトを...
-
弥生会計に移行
-
「弥生会計」は毎年買い替える...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
アクセスのパラメータに既定値...
-
ヤマト運輸 宅急便の社員割引...
-
Accessフォームのボタンの二度...
-
勘定奉行の売上削除
-
【弥生販売】請求締切後の売上...
-
会社で複写式伝票を手書きで作...
-
伝票のプリンタはレーザーかド...
-
エクセルにて伝票番号ごとに小...
-
弥生会計11 現金出納帳 並び替え
-
勘定奉行での伝票の追加方法
-
エクセルでシリアリナンバーを...
-
Excel VBAについて
-
弥生会計の伝票バインダ
-
弥生販売で数量や金額に0ゼロ...
-
弥生販売の請求書番号を印刷し...
-
弥生会計の印刷
-
プリンターで印刷できる、複写...
-
弥生販売で売上伝票をエクスポ...
-
excel VBAで納品書の雛形から納...
-
PCA社の会計ソフトの専用帳票は...
おすすめ情報
こんばんは。
マクロで変換できると非常に有り難いです(*´ω`*)
区分けは「伝票番号」です。
色分けは、伝票が分かれているのが理解しやすいようにしてあるだけで、実際には色分けはしていないです。
「999」の送料は発生する人もいるし、かからない人もいるので、必ずあるとは限りません。
1枚の伝票で何品かお買い上げになっていて、送料があったりなかったりです。
その売り上げがエクセルの表でずらーと並んでいます。
日付けの順番もバラバラなので「伝票番号」だけが区切りになります。
わかりずらくて申し訳ありません。
よろしくお願いいたします。
すごい!!!すごい!!!すごすぎる!!!!!!
手品みたいです!!!
ありがとうございます(≧▽≦)
わ~、これがあれば業務が進みます。
実際のデータはもっと沢山の項目がありますが、これは
For Each k In Array(1, 2, 3, 6, 5, 4) '項目の順序
や
With .Range("A1:F1")
.Value = Array("日付", "桁番号", "品番", "品名", "個数", "金額")
の項目を増やしていけばいいのでしょうか?
興奮冷めやらぬ状態です!!
嬉しいです!
Sheet1は以下の項目です。
"日付","相手先出荷番号","注文番号","ご注文方法","項目","その他","金額","数量","商品名"
Sheet2は以下の項目です。
"削除マーク","締めフラグ","チェック","日付","伝票番号","伝票区分","取引区分","税転嫁","金額端数処理","税端数処理","得意先コード","空白1","担当者コード","行番号","明細区分","商品コード","空白2","商品名","課税区分","単位","入数","ケース","倉庫コード","数量","単位","金額","空白3","税抜き金額","原価","原単価","備考","納入期限","受入残数","数量少数桁","単位少数桁","規格・型番","色","サイズ","伝票区分","得意先名1","空白5","空白6","空白7","空白8","空白9","空白10","空白11","空白12","空白13","空白14","空白15","空白16","得意先名2"
これは、この間の質問で WindFallerさんに教えていただいたマクロで作成しました(*^_^*)
大変役立っております。
お世話になりっぱなしで申し訳ありませんが、もうしばらくご指導よろしくお願いいたします。
すみません。
Sheet1の”相手先出荷番号”が質問した「商品名」の下にくる「伝票番号」です。
Sheet2の”伝票番号”は管理ソフト側の伝票番号なので、自動記入のため、関係ありません。
わかりづらくて申し訳ありませんが、よろしくお願いいたします。
すみません。
こちらに書いた方が良かったんですよね。
もう一度、同じ内容ですが、記載いたします。
何度もやり直しをしながら作成をしてくださっているようで、本当に有り難く何とお礼を申し上げたらよいかわからない程、感謝しております。
ありがとうございます。
以前の質問内容と記述が異なり、紛らわしくて申し訳ありません。
桁番号は、Sheet1には存在しておらず、Sheet2では"行番号"にあたります。
Sheet1の”相手先出荷番号”が質問した「商品名」の下にくる「伝票番号」です。
ですので以前の質問の「伝票番号」⇒「相手先出荷番号」です。
以前の質問の「品名」⇒「商品名」となります。
こんな面倒なことをお願いし、申し訳ありません。
どうぞ、よろしくお願いいたします。
ありがとうございます(*゚▽゚*)
本当にご面倒をお掛けし、申し訳ありません。
本当に本当に助かります。
ご親切にありがとうございます。
よろしくお願いしますm(__)m
すご----------い!!ヽ(^o^)丿
できました!ありがとうございます!
本当に感動で鳥肌がたちました(#^.^#)
甘えついでに、もう一箇所だけ教えていただいても宜しいですか?
これで、もう完璧になり、誰にでも使ってもらえそうです。
「削除マーク」「締めプラグ」などは伝票を記入する際、必ず同じ数字を記入する必要があります。
対応表に追加しました。(ピンク色)・・・図①
マクロを作成できない私は、関数で何とかしようと、Sheet1に追加した欄には「=IF(I4="","","1")」を入れて商品名が入ったら「1」など規定の数字が入るようにしました。
試してみると図②になってしまいました。
なりたい形としては図③です。
何度もお時間をいただき申し訳ありませんが、これが最後だと思いますので、どうぞよろしくお願いいたします。
WindFallerさま
できました!!!めっちゃ綺麗にできました\(◎o◎)/!
感動以外ないです。
本当にありがとうございました。
>それにしても、今回、詳しい説明をしていませんでしたが、仕様変更にもかかわらず、よく設定・実行ができたことに、かなり驚きました。
マクロは以前すこーしだけ学んだことがあって挫折しました・・・
なので、貼り付け場所や実行方法などはわかっているので、なんとかできました。
こんな魔法のようなマクロを作成していただいたことに深く感謝いたします。
本当にありがとうございました。
ベストアンサーは皆さんがよく使用しそうな初めに送っていただいた回答にさせていただきますね。
長きに渡りお付き合いありがとうございました。
何度お礼を言っても足りないくらいです。
本当に感謝です。ありがとうございました。