Results of 1 - 1 of about 470 for EDATE (0.000 sec.)
- [[20180725101840]]
- #score: 9974
- @digest: d8be6d6fcc555c57d6f3c44597f80b0f
- @id: 76904
- @mdate: 2018-07-26T08:21:10Z
- @size: 8950
- @type: text/plain
- #keywords: 積日 (41157), 積金 (34092), 注金 (23562), 出用 (20089), 品見 (20030), 額受 (17590), 提出 (17324), 出. (15934), xlvisible (13268), 見積 (12958), 受注 (12709), 注日 (11936), 表") (9980), 額1 (8552), criteria2 (8464), 日受 (8339), 理表 (7320), 日15 (7313), 表通 (7179), 日7 (6604), 「提 (6527), 日12 (6292), 月10 (5898), 月12 (5883), 日1 (5570), operator (4993), xland (4875), り7 (4736), 月15 (4622), 金額 (3422), autofilter (3410), 管理 (3294)
- 『A表からB表へコピーするコードについて』（わわ）
下記のコードを書きましたがそもそもの構成が違うようなエラーが出てしまいます。 「管理表」に日々の情報を入力、 その後、M1からN1の期間、尚且つ100円以上200円以下の条件で、見積金額と受注金額を「提出用の表」にコピペしたいのです。 ただ、「提出用の表」に直接入れるコードをかけないので、「提出用の表」横に一旦抽出し、関数で引っ張っていますので、正しくいうと「提出用の表の横」という事になります。ややこしくてすみません。 管理表 a b c d e 1 商品 見積日 見積金額 受注日 受注金額 2 ぺん 7月10日 110 3 のり 7月10日 120 7月12日 120 4 はさみ 7月4日 150 7月15日 150 5 ふせん 7月12日 250 提出用の表 m n 1 7月10日 7月15日 g h i j k 商品 見積日 見積金額 受注日 受注金額 1 ぺん 7月10日 110 2 のり 7月10日 120 3 のり 7月12日 120 4 はさみ 7月15日 150 5 Sub 提出用の表() Dim sh As Worksheet Worksheets("提出用の表").Activate Worksheets("提出用の表").Range("G2:Z100").Clear For Each sh In Worksheets Select Case sh.Name Case "管理表" With sh.Range("A1") .AutoFilter Field:=2, Criteria1:=">=" & Range("M1").Value, Operator:=xlAnd, Criteria2:="<=" & Range("N1").Value .AutoFilter Field:=3, Criteria1:=">=100", Operator:=xlAnd, Criteria2:="<=200" If Range("D1").Value <> "" Then .CurrentRegion.Offset(1).SpecialCells(xlVisible).Copy Else .CurrentRegion.Offset(1).SpecialCells(xlVisible).Copy .Columns("D:E").ClearContents End If Sheets("提出用の表").Range("G" & Rows.Count).End(xlUp).Offset (1) .AutoFilter End With Case Else End Select Select Case sh.Name Case "管理表" With sh.Range("A1") .AutoFilter Field:=4, Criteria1:=">=" & Range("M1").Value, Operator:=xlAnd, Criteria2:="<=" & Range("N1").Value .AutoFilter Field:=5, Criteria1:=">=100", Operator:=xlAnd, Criteria2:="<=200" If Range("B1").Value <> "" Then .CurrentRegion.Offset(1).SpecialCells(xlVisible).Copy Else .CurrentRegion.Offset(1).SpecialCells(xlVisible).Copy .Columns("B:C").ClearContents End If Sheets("提出用の表").Range("G" & Rows.Count).End(xlUp).Offset (1) .AutoFilter End With Case Else End Select 修正または正しいコードをご教授いただけますでしょうか。 どうぞ宜しくお願い致します。 ＜ 使用 Excel:unknown、使用 OS:Windows7 ＞ ---- Sub main() Dim c As Range, r As Range With Sheets("提出用の表") .Range("A:E").Cells.Clear .Range("A1:E1").Value = Sheets("管理表").Range("A1:E1").Value For Each c In Sheets("管理表").Range("B:E").SpecialCells(2) If IsDate(c.Value) And c.Value >= .Range("M1").Value And c.Value <= .Range("N1").Value And c.Offset(, 1).Value >= 100 And c.Offset(, 1).Value <= 200 Then Set r = .Range("A" & Rows.Count).End(xlUp).Offset(1) r.Value = c.EntireRow.Cells(1).Value r.Offset(, c.Column - 1).Resize(, 2).Value = Array(c.Value, c.Offset(, 1).Value) End If Next c End With End Sub （mm） 2018/07/25(水) 13:07 ---- コードを見ると表題より色々なことをしているようですが、 A表からB表にコピーするだけなら以下のコードでOKです。 二つ以上のシートを操作するときは、シート名を指定したほうが安全ですよ。 Sub 回答例() Dim 管理 As Worksheet, 提出 As Worksheet Set 管理 = ThisWorkbook.Sheets("管理表") Set 提出 = ThisWorkbook.Sheets("提出用の表") If IsDate(提出.Range("M1").Value) = False Or IsDate(提出.Range("N1").Value) = False Then MsgBox "期間を正しく入力してください" Exit Sub End If 提出.Range("G:K").ClearContents With 管理.Range("A1") If 管理.AutoFilterMode Then .AutoFilter .AutoFilter Field:=2, Criteria1:=">=" & 提出.Range("M1").Value, _ Operator:=xlAnd, Criteria2:="<=" & 提出.Range("N1").Value .AutoFilter Field:=3, Criteria1:=">=100", Operator:=xlAnd, Criteria2:="<=200" .CurrentRegion.Copy 提出.Range("G1") End With End Sub （TAKA） 2018/07/25(水) 13:33 ---- Sub main() '列を間違えてました。 Dim c As Range, r As Range With Sheets("提出用の表") .Range("G:K").Cells.Clear .Range("G1:K1").Value = Sheets("管理表").Range("A1:E1").Value For Each c In Sheets("管理表").Range("B:E").SpecialCells(2) If IsDate(c.Value) And c.Value >= .Range("M1").Value And c.Value <= .Range("N1").Value And c.Offset(, 1).Value >= 100 And c.Offset(, 1).Value <= 200 Then Set r = .Range("G" & Rows.Count).End(xlUp).Offset(1) r.Value = c.EntireRow.Cells(1).Value r.Offset(, c.Column - 1).Resize(, 2).Value = Array(c.Value, c.Offset(, 1).Value) End If Next c End With End Sub （mm） 2018/07/25(水) 13:46 ---- TAKA様、mm様 ご返信大変感謝しております。 ありがとうございます。 TAKA様 自分のやり方が悪いのか、受注額が見積額と横並びになりはさみが抜けて 提出の表通りに表示されませんでした。 しかし、とても分かり易いので応用できればと思います。 mm様 上手く提出の表通りに表示できました、ありがとうございます。 ただ、実際の表は、文字が入ってる列・日付が複数あり、金額の列も日付の次ではない為offsetが使えず mm様のコードを理解しながらセルや数字を変更していましたが、どうしても ・文字や日付があるセルは一列しかコピペすることができません。 下記の場合ですとどのようになるのか、 どうぞ宜しくお願い致します。 管理表 a b c d e f g h i j k 商品1 その1 その2 その3 その4 見積金額1見積金額2見積金額3見積金額4見積日1見積日2 ぺん 110 10 10 10 7月10日 7月10日 のり 120 10 10 10 7月10日 7月10日 はさみ 150 10 10 10 7月4日 7月4日 ホッチキス 250 10 10 10 7月12日 7月12日 （表は横に続ます） l m n o p q r s t u v その5 その6 その7 その8 その9 その10 その11 その12 受注金額受注日1 受注日2 120 7月12日 7月12日 150 7月15日 7月15日 提出用の表 商品 見積日1 見積金額1受注日 受注金額 1 ぺん 7月10日 110 2 のり 7月10日 120 3 のり 7月12日 120 4 はさみ 7月15日 150 5 （わわ） 2018/07/26(木) 15:24 ---- こんな方法もあります。 Sub test() Dim cn As Object, rs As Object, sDate As String, eDate As String, i As Long Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") With cn .Provider = "Microsoft.Ace.OLEDB.12.0" .Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1;" .Open ThisWorkbook.FullName End With With Sheets("提出用の表") sDate = Format$(.Range("m1").Value, "yyyy/mm/dd") eDate = Format(.Range("n1").Value, "yyyy/mm/dd") .Cells(1).CurrentRegion.Resize(, 11).ClearContents rs.Open "Select 商品1 As 商品, 見積日1, 見積金額1, Null As 受注日, Null As 受注金額 From `管理表$` " & _ "Where 見積金額1 Between 100 And 200 And 見積日1 >= #" & sDate & "# And 見積日1 <= #" & eDate & "#", cn, 3 For i = 0 To rs.Fields.Count - 1 .Cells(1, i + 1).Value = rs.Fields(i).Name Next .[a2].CopyFromRecordset rs: rs.Close rs.Open "Select 商品1, Null As 見積日1, Null As 見積金額1, 受注日1 As 受注日, 受注金額 From `管理表$` " & _ "Where 受注金額 Between 100 And 200 And 受注日1 >=#" & sDate & "# And 受注日1 <=#" & eDate & "#", cn, 3 .Range("a" & Rows.Count).End(xlUp)(2).CopyFromRecordset rs End With Set cn = Nothing: Set rs = Nothing End Sub （seiya） 2018/07/26(木) 17:21... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201807/20180725101840.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97050 documents and 608253 words.
訪問者：