誠にすみませんが おねがいします。
エクセルで注文書と入荷の受入処理を行いたくマクロを作ってます。
途中 みなさんからお聞きしたマクロ文を参考にしてます。
注文書発行後そのデータをT_注文シートに最終行を確認して貼り付けます。
受入処理はそのT_注文シートの項目の注文番号を指定して
T_受入処理シートに張ります。ここで 受入の諸事項を記入して再度、
T_注文シートにID番号で完全一致させ上書きさせたいと考えてます。
しかし、下記のマクロだと途中の
'既存データの修正
x.PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
で デバックしてとまります。ローカルウィンドで確認したら
ｘはNothingでした。
なぜでしょうか？教えてください。
マクロの全文です。
Sub 受入処理()
Dim z As Long '[T_注文]シートの最終行番号
Dim x As Range '検索したセル
'画面を固定
Application.ScreenUpdating = False
If Range("T_受入処理!C21").Value = "" Then
MsgBox "受入有無が未記入です。確認してからこの処理をおこなってください。", vbOKOnly, "オービットベース データ有無確認"
Exit Sub
End If
If Range("T_受入処理!C22").Value = "" Then
MsgBox "受入日が未記入です。確認してからこの処理をおこなってください。", vbOKOnly, "オービットベース データ有無確認"
Exit Sub
End If
If Range("T_受入処理!C23").Value = "" Then
MsgBox "受入数が未記入です。確認してからこの処理をおこなってください。", vbOKOnly, "オービットベース データ有無確認"
Exit Sub
End If
If Range("T_受入処理!C24").Value = "" Then
MsgBox "受入単価が未記入です。確認してからこの処理をおこなってください。", vbOKOnly, "オービットベース データ有無確認"
Exit Sub
End If
'入力したデータをコピー
Range("c5:c24").Copy
'[T_注文]シートを選択
Sheets("T_注文").Select
'最終行番号を取得
z = Range("a1").End(xlDown).Row
'[番号]を検索（ここをみなさんから教えていただきました。）
Set x = Range("a2:a" & z).Find(What:=Range("T_受入処理!c5").Value, _
LookIn:=xlValues, _
LookAt:=xlWhole)
'既存データの修正
x.PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
'コピーモードを解除
Application.CutCopyMode = False
MsgBox "この品目の受入処理を完了しました。", vbOKOnly, "オービットベース:受入処理完了"
'[入力]シートを選択
Sheets("T_受入処理").Select
'画面の固定を解除
Application.ScreenUpdating = True
いつもお世話になっております。
現在dictionary勉強中ですが、なかなかコツをつかめず
思ったとおりのマクロを作成することができません（ノ_；）
ところで、今回作成しているのは
元データ.xlsというファイルのシート（データ）に
｜【A】｜ B ｜ C ｜【D】｜ E ｜ F ｜・・・｜H｜I｜【J】｜K
3 【顧客ID】｜顧客｜受付日｜【担当】｜・・・｜【会場名】｜（見出し）
4 データの始まり↓
と、ありまして、
集計データ.xlsのシート（集計）に
｜ A ｜ B ｜ C ｜ D ｜ E ｜ F ｜
1 顧客ID｜担当｜会場名｜
と二行目から一覧表があります。
A列のIDが一致するものに
Sheet（データ） → Sheet（集計）
セル( i, "D")の値 → セル( j, "B") に
セル( i, "J")の値 → セル( j, "C")に
セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで（4回のみ）
A列のIDが一致するものがない時
セル( i, "A")の値 → セル( 最終,"A")に
セル( i, "D")の値 → セル( 最終, "B") に
セル( i, "J")の値 → セル( 最終,"C")に追加
というように、入れたいのですが、
以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが
あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。
Sub Try()
Dim data_1() As String
Dim data As Long
Dim maxrow As Long
Dim t As Integer, f As Integer, y As Integer
Set ws1 = Worksheets("集計")
Set ws2 = Worksheets("データ")
Application.ScreenUpdating = False
maxrow = ws2.Range("a65536").End(xlUp).Row
With ws1
For i = 2 To Range("a65536").End(xlUp).Row
data = .Cells(i, 1)
f = 0
t = 0
With ws2
t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data)
If t > 0 Then
For n = 1 To maxrow
ReDim Preserve data_1(f)
If data = .Cells(n, 1) Then
data_1(f) = .Cells(n, 10)
f = f + 1
If t = f Then Exit For
Else
'A列にIDが存在しなければ追加する：ここの記述がよく分かりません。
data_1(f) = .Cells(n, 1)
End If
Next n
For y = 0 To UBound(data_1)
ws1.Cells(i, maxcol(i)) = data_1(y)
Next y
End If
End With
Next i
End With
Application.ScreenUpdating = True
End Sub
'--------------------------
Private Function maxcol(ByVal i As Long) As Integer
Dim j As Integer
With Worksheets("集計")
j = 4
Do While .Cells(i, j) <> ""
j = j + 1
Loop
maxcol = j
End With
End Function
いつもお世話になっております。
現在dictionary勉強中ですが、なかなかコツをつかめず
思ったとおりのマクロを作成することができません（ノ_；）
ところで、今回作成しているのは
元データ.xlsというファイルのシート（データ）に
｜【A】｜ B ｜ C ｜【D】｜ E ｜ F ｜・・・｜H｜I｜【J】｜K
3 【顧客ID】｜顧客｜受付日｜【担当】｜・・・｜【会場名】｜（見出し）
4 データの始まり↓
と、ありまして、
集計データ.xlsのシート（集計）に
｜ A ｜ B ｜ C ｜ D ｜ E ｜ F ｜
1 顧客ID｜担当｜会場名｜
と二行目から一覧表があります。
A列のIDが一致するものに
Sheet（データ） → Sheet（集計）
セル( i, "D")の値 → セル( j, "B") に
セル( i, "J")の値 → セル( j, "C")に
セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで（4回のみ）
A列のIDが一致するものがない時
セル( i, "A")の値 → セル( 最終,"A")に
セル( i, "D")の値 → セル( 最終, "B") に
セル( i, "J")の値 → セル( 最終,"C")に追加
というように、入れたいのですが、
以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが
あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。
Sub Try()
Dim data_1() As String
Dim data As Long
Dim maxrow As Long
Dim t As Integer, f As Integer, y As Integer
Set ws1 = Worksheets("集計")
Set ws2 = Worksheets("データ")
Application.ScreenUpdating = False
maxrow = ws2.Range("a65536").End(xlUp).Row
With ws1
For i = 2 To Range("a65536").End(xlUp).Row
data = .Cells(i, 1)
f = 0
t = 0
With ws2
t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data)
If t > 0 Then
For n = 1 To maxrow
ReDim Preserve data_1(f)
If data = .Cells(n, 1) Then
data_1(f) = .Cells(n, 10)
f = f + 1
If t = f Then Exit For
Else
'A列にIDが存在しなければ追加する：ここの記述がよく分かりません。
data_1(f) = .Cells(n, 1)
End If
Next n
For y = 0 To UBound(data_1)
ws1.Cells(i, maxcol(i)) = data_1(y)
Next y
End If
End With
Next i
End With
Application.ScreenUpdating = True
End Sub
'--------------------------
Private Function maxcol(ByVal i As Long) As Integer
Dim j As Integer
With Worksheets("集計")
j = 4
Do While .Cells(i, j) <> ""
j = j + 1
Loop
maxcol = j
End With
End Function
いつもお世話になっております。
現在dictionary勉強中ですが、なかなかコツをつかめず
思ったとおりのマクロを作成することができません（ノ_；）
ところで、今回作成しているのは
元データ.xlsというファイルのシート（データ）に
｜【A】｜ B ｜ C ｜【D】｜ E ｜ F ｜・・・｜H｜I｜【J】｜K
3 【顧客ID】｜顧客｜受付日｜【担当】｜・・・｜【会場名】｜（見出し）
4 データの始まり↓
と、ありまして、
集計データ.xlsのシート（集計）に
｜ A ｜ B ｜ C ｜ D ｜ E ｜ F ｜
1 顧客ID｜担当｜会場名｜
と二行目から一覧表があります。
A列のIDが一致するものに
Sheet（データ） → Sheet（集計）
セル( i, "D")の値 → セル( j, "B") に
セル( i, "J")の値 → セル( j, "C")に
セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで（4回のみ）
A列のIDが一致するものがない時
セル( i, "A")の値 → セル( 最終,"A")に
セル( i, "D")の値 → セル( 最終, "B") に
セル( i, "J")の値 → セル( 最終,"C")に追加
というように、入れたいのですが、
以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが
あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。
Sub Try()
Dim data_1() As String
Dim data As Long
Dim maxrow As Long
Dim t As Integer, f As Integer, y As Integer
Set ws1 = Worksheets("集計")
Set ws2 = Worksheets("データ")
Application.ScreenUpdating = False
maxrow = ws2.Range("a65536").End(xlUp).Row
With ws1
For i = 2 To Range("a65536").End(xlUp).Row
data = .Cells(i, 1)
f = 0
t = 0
With ws2
t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data)
If t > 0 Then
For n = 1 To maxrow
ReDim Preserve data_1(f)
If data = .Cells(n, 1) Then
data_1(f) = .Cells(n, 10)
f = f + 1
If t = f Then Exit For
Else
'A列にIDが存在しなければ追加する：ここの記述がよく分かりません。
data_1(f) = .Cells(n, 1)
End If
Next n
For y = 0 To UBound(data_1)
ws1.Cells(i, maxcol(i)) = data_1(y)
Next y
End If
End With
Next i
End With
Application.ScreenUpdating = True
End Sub
'--------------------------
Private Function maxcol(ByVal i As Long) As Integer
Dim j As Integer
With Worksheets("集計")
j = 4
Do While .Cells(i, j) <> ""
j = j + 1
Loop
maxcol = j
End With
End Function
いつもお世話になっております。
現在dictionary勉強中ですが、なかなかコツをつかめず
思ったとおりのマクロを作成することができません（ノ_；）
ところで、今回作成しているのは
元データ.xlsというファイルのシート（データ）に
｜【A】｜ B ｜ C ｜【D】｜ E ｜ F ｜・・・｜H｜I｜【J】｜K
3 【顧客ID】｜顧客｜受付日｜【担当】｜・・・｜【会場名】｜（見出し）
4 データの始まり↓
と、ありまして、
集計データ.xlsのシート（集計）に
｜ A ｜ B ｜ C ｜ D ｜ E ｜ F ｜
1 顧客ID｜担当｜会場名｜
と二行目から一覧表があります。
A列のIDが一致するものに
Sheet（データ） → Sheet（集計）
セル( i, "D")の値 → セル( j, "B") に
セル( i, "J")の値 → セル( j, "C")に
セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで（4回のみ）
A列のIDが一致するものがない時
セル( i, "A")の値 → セル( 最終,"A")に
セル( i, "D")の値 → セル( 最終, "B") に
セル( i, "J")の値 → セル( 最終,"C")に追加
というように、入れたいのですが、
以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが
あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。
Sub Try()
Dim data_1() As String
Dim data As Long
Dim maxrow As Long
Dim t As Integer, f As Integer, y As Integer
Set ws1 = Worksheets("集計")
Set ws2 = Worksheets("データ")
Application.ScreenUpdating = False
maxrow = ws2.Range("a65536").End(xlUp).Row
With ws1
For i = 2 To Range("a65536").End(xlUp).Row
data = .Cells(i, 1)
f = 0
t = 0
With ws2
t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data)
If t > 0 Then
For n = 1 To maxrow
ReDim Preserve data_1(f)
If data = .Cells(n, 1) Then
data_1(f) = .Cells(n, 10)
f = f + 1
If t = f Then Exit For
Else
'A列にIDが存在しなければ追加する：ここの記述がよく分かりません。
data_1(f) = .Cells(n, 1)
End If
Next n
For y = 0 To UBound(data_1)
ws1.Cells(i, maxcol(i)) = data_1(y)
Next y
End If
End With
Next i
End With
Application.ScreenUpdating = True
End Sub
'--------------------------
Private Function maxcol(ByVal i As Long) As Integer
Dim j As Integer
With Worksheets("集計")
j = 4
Do While .Cells(i, j) <> ""
j = j + 1
Loop
maxcol = j
End With
End Function
いつもお世話になっております。
現在dictionary勉強中ですが、なかなかコツをつかめず
思ったとおりのマクロを作成することができません（ノ_；）
ところで、今回作成しているのは
元データ.xlsというファイルのシート（データ）に
｜【A】｜ B ｜ C ｜【D】｜ E ｜ F ｜・・・｜H｜I｜【J】｜K
3 【顧客ID】｜顧客｜受付日｜【担当】｜・・・｜【会場名】｜（見出し）
4 データの始まり↓
と、ありまして、
集計データ.xlsのシート（集計）に
｜ A ｜ B ｜ C ｜ D ｜ E ｜ F ｜
1 顧客ID｜担当｜会場名｜
と二行目から一覧表があります。
A列のIDが一致するものに
Sheet（データ） → Sheet（集計）
セル( i, "D")の値 → セル( j, "B") に
セル( i, "J")の値 → セル( j, "C")に
セル(j,"C")に値が入っているとき、セル(j,"D")に→Fまで（4回のみ）
A列のIDが一致するものがない時
セル( i, "A")の値 → セル( 最終,"A")に
セル( i, "D")の値 → セル( 最終, "B") に
セル( i, "J")の値 → セル( 最終,"C")に追加
というように、入れたいのですが、
以下のようなコードをネットで見つけ自分なりに考えて変更を加えてみましたが
あまり分かっていないためどのように変更すればいいのかよく分かりません。どなたかご教授ください。お願いします。
Sub Try()
Dim data_1() As String
Dim data As Long
Dim maxrow As Long
Dim t As Integer, f As Integer, y As Integer
Set ws1 = Worksheets("集計")
Set ws2 = Worksheets("データ")
Application.ScreenUpdating = False
maxrow = ws2.Range("a65536").End(xlUp).Row
With ws1
For i = 2 To Range("a65536").End(xlUp).Row
data = .Cells(i, 1)
f = 0
t = 0
With ws2
t = Application.WorksheetFunction.CountIf(.Range("a4:a" & maxrow), data)
If t > 0 Then
For n = 1 To maxrow
ReDim Preserve data_1(f)
If data = .Cells(n, 1) Then
data_1(f) = .Cells(n, 10)
f = f + 1
If t = f Then Exit For
Else
'A列にIDが存在しなければ追加する：ここの記述がよく分かりません。
data_1(f) = .Cells(n, 1)
End If
Next n
For y = 0 To UBound(data_1)
ws1.Cells(i, maxcol(i)) = data_1(y)
Next y
End If
End With
Next i
End With
Application.ScreenUpdating = True
End Sub
'--------------------------
Private Function maxcol(ByVal i As Long) As Integer
Dim j As Integer
With Worksheets("集計")
j = 4
Do While .Cells(i, j) <> ""
j = j + 1
Loop
maxcol = j
End With
End Function
winXP Excel2003でマクロ作成している初心者です。
１）指定した４個のシート以外を選択するコードを教えていただきました。
これを利用して
list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略") の
部分を手修正でなく、追加削除にも対応できるように指定シート以外を選択したいのですがうまくいきません。
どうかお助けください。
ーーーーーーーーーーーーーーーーーーーーーーーーーーー
教えていただいたコード
Sub 請求書入力()
' // 処理を除外するシート名リスト
Const EXCEPT_NAME = "集計用 印刷用 リンク用 会社見本"
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If InStr(EXCEPT_NAME, sh.Name) = 0 Then
sh.Activate
Call 請求書作成用部品
End If
Next
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーー
現在のマクロコード
Sub 請求一覧表作成()
Application.ScreenUpdating = False
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Call BookOpen("請求書入力.xls")
Dim list, SheetName
Sheets("請求一覧表").Select
Range("A4:U15").Select
Selection.ClearContents
Range("A4").Select
list = Array("ＡＡＡ会社", "ＢＢＢ会社", "ＣＣＣ会社", "ＤＤＤ会社", "ＥＥＥ会社", ・・以下略")
↑この部分はシートの追加・削除の度に手修正している。
For Each SheetName In list
Sheets(SheetName).Activate
Call 配列
Next
Worksheets("請求一覧表").Activate
ActiveSheet.Protect
End Sub
ーーーーーーーーーーーーーーーーーーーーーーー
Sub 配列()
With ActiveSheet
' 配列に格納 --
Dim i As Integer
Dim LastRow As Long
Dim SaleAry As Variant
' 配列に格納 --
SaleAry = Array(.Range("C8"), .Range("D13"), .ange("T30")・・・以下略))
End With
' 転記 ---
With Worksheets("請求一覧表")
LastRow = .Range("A65536").End(xlUp).Row
For i = 0 To UBound(SaleAry)
.Cells(LastRow + 1, i + 1).Value = SaleAry(i)
Next i
End With
Set SaleAry = Nothing
End Sub
A列とE列の文字列になってしまった数値を
数値に変換したく、以下のようなものを作ったのですが、
文字の無いセルまで、数値に変換しようとするので
時間がかなりかかります。
何かよい方法は無いでしょうか？
よろしくお願いいたします。
Sub 数値に変換()
Range("A:A,E:E").Select
For Each xCell In Selection
xCell.Value = xCell.Value
Next xCell
End Sub
使用ソフトEXCEL2000orEXCEL2003
リストボックスからデータを転記したいのですが、
実行時エラー"1004"が出てしまい、どうしてもうまくいきません。
どなたか原因を教えてください。
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
With Worksheets("sheet2")
i = .Range("F47").End(xlUp).Row + 1
.Range(i, 6).Value = ListBox1.List(ListBox1.ListIndex, 0)
.Range(i, 12).Value = ListBox1.List(ListBox1.ListIndex, 1)
.Range(i, 26).Value = ListBox1.List(ListBox1.ListIndex, 2)
.Range(i, 28).Value = ListBox1.List(ListBox1.ListIndex, 3)
.Range(i, 34).Value = ListBox1.List(ListBox1.ListIndex, 4)
.Range(i, 37).Value = ListBox1.List(ListBox1.ListIndex, 5)
End With
Unload Me
End Sub
よろしくお願いします。
今、ユーザーフォームを使って製造計画表を作っています。
コンボボックスで会社名、リストボックスで会社ごとの製品名を選択させるとこまで出来ました。
１日に３つの製品を作ることが出来るので、同じ中身のコンボボックス、リストボックスを使って３つ作りたいと思っています。
ユーザーフォームの形的にはこのような感じですが。
１． コンボボックス リストボックス
２． コンボボックス リストボックス
３． コンボボックス リストボックス
今は、１．のとこだけは出来たのですが、２．３．は１．と同じコードをコピーして必要と思われるとこだけをコンボボックス２と変えたりしてみたのですが、上手くいきませんでした。こんなコードですが。
Private Sub UserForm_initialize()
'ComboBox1セット
Dim ico As Long
ico = 1
With ThisWorkbook.Worksheets("Sheet1")
Do While .Cells(1, ico) <> ""
Me.ComboBox1.AddItem .Cells(1, ico).Value
ico = ico + 1
Loop
End With
Me.ComboBox1.SetFocus
End Sub
Private Sub ComboBox1_Change()
'ListBox1セット
Dim ico As Long
'Me.ListBox1.Clear
ico = Me.ComboBox1.ListIndex + 1
With ThisWorkbook.Worksheets("Sheet1")
Me.ListBox1.List = .Range(.Cells(2, ico), _
.Cells(.Cells(Rows.Count, ico).End(xlUp).Row, ico)).Value
End With
End Sub
ＶＢＡも初めたばかりで質問の内容もわかりづらいとも思いますが、よろしくお願いします。
