Excel VBA質問箱 IV

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

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


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

29 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【81908】Re:数行おきに範囲指定してdelete

たろまる - 22/1/12(水) 0:31 -


	引用なし

	パスワード

▼マナさん：
ありがとうございます、無事動作しました。ちなみになのですが、これはどこの行まで行う等はどの部分で指定しているのでしょうか？
差し支えなければ教えて頂けると助かります。

・ツリー全体表示


	【81907】Re:数行おきに範囲指定してdelete

マナ - 22/1/11(火) 23:07 -


	引用なし

	パスワード

▼たろまるさん：

Option Explicit

Sub test()
　　Dim ws As Worksheet
Dim k As Long
Dim u As Range, r As Range

　　For Each ws In Worksheets
　　　　Set u = Nothing
　　　　For k = 8 To ws.Cells(Rows.Count, "J").End(xlUp).Row Step 3
　　　　　　Set r = ws.Cells(k, "J").Resize(2, 12)
　　　　　　If u Is Nothing Then
　　　　　　　　Set u = r
　　　　　　Else
　　　　　　　　Set u = Union(u, r)
　　　　　　End If
　　　　Next
　　　　If Not u Is Nothing Then u.ClearContents
　　Next

End Sub

・ツリー全体表示


	【81906】数行おきに範囲指定してdelete

たろまる - 22/1/11(火) 21:09 -


	引用なし

	パスワード

J列からU列までの間でまず8,9行目を選択、１行あけて11、12行目を選択これを繰り返して一括でセルの数値を削除する方法はありますでしょうか？複数sheetがあり、最終行がバラバラのためそこの判断も良い方法がありましたら教えて頂けると助かります。
初歩的なことかもしれませんが、何卒よろしくお願い致します。

・ツリー全体表示


	【81905】特定の日付の一ヶ月前に自動でメール送信

Ya - 22/1/11(火) 14:33 -


	引用なし

	パスワード

例えば部品の交換期限の管理をしてるExcelファイルで期限1ヶ月前になったらOutlookに自動でメール送信されるようにするなどといった事はVBA等を使用して可能なのでしょうか？

・ツリー全体表示


	【81904】Re:所定フォームへの流し込み

マナ - 22/1/9(日) 19:30 -


	引用なし

	パスワード

▼ackkn さん：
>行き詰まり、時間が無く困っています。
>毎年年末になると、荷主様から主要配送先への送り込み予定データが送られてきます。

i今更ですが、2022年末用に。
Sheet2の日付と曜日は、手作業で用意しておいてください。

Option Explicit

Sub test()
　　Dim r1 As Range, r2 As Range
　　Dim v, n As Long, w()
　　Dim dic As Object
　　Dim s As String, k As Long
　　Dim d As Long
　　
　　Set r1 = Sheet1.Range("A1").CurrentRegion
　　Set r1 = Intersect(r1, r1.Offset(1))
　　
　　Set r2 = Sheet2.UsedRange.Offset(2)
　　r2.ClearContents

　　v = WorksheetFunction.Sort(r1, 3)
　　n = UBound(v)
　　ReDim w(n * 2, 1 To r2.Columns.Count + 1)
　　Set dic = CreateObject("scripting.dictionary")
　　
　　For k = 1 To n
　　　　s = v(k, 3) & vbTab & v(k, 4)
　　　　If Not dic.exists(s) Then
　　　　　　dic(s) = dic.Count * 2
　　　　　　w(dic(s), 1) = v(k, 3)
　　　　　　w(dic(s), 2) = v(k, 4)
　　　　End If
　　　　d = (Day(v(k, 1)) - 13) * 2 + 3
　　　　w(dic(s), d) = v(k, 5)
　　　　w(dic(s), d + 1) = v(k, 6)
　　　　w(dic(s) + 1, d + 1) = v(k, 7)
　　Next
　　
　　r2.Resize(dic.Count * 2, UBound(w, 2)).Value = w
　　
End Sub

・ツリー全体表示


	【81903】Re:Sheet1からSheet 2に日付を条件として...

えん - 22/1/8(土) 14:22 -


	引用なし

	パスワード

▼マナさん：
Sheet1のB1がSharePointリストとの接続で作成していたテーブルデータだったため、"OData_日付"となっていました。
これを日付に変更したら、問題なくできました。

本当にありがとうございました。

・ツリー全体表示


	【81902】Re:Sheet1からSheet 2に日付を条件として...

マナ - 22/1/8(土) 14:17 -


	引用なし

	パスワード

▼えんさん：
>Sheet2のA列2行目以降が空白に置き換わってしまうのは変わらずです。

Sheet1のB1とSheet2のA1は、
どちらも「日付」という文字で間違いありませんか

・ツリー全体表示


	【81901】Re:Sheet1からSheet 2に日付を条件として...

えん - 22/1/8(土) 13:52 -


	引用なし

	パスワード

Sheet1の日付欄が時刻付きとなっていた為、日付のみに変更した所、testの方は数値が飛びました。しかし、Sheet2のA列2行目以降が空白に置き換わってしまうのは変わらずです。

私のミスで、錯綜させてしまい申し訳ございません

・ツリー全体表示


	【81900】Re:Sheet1からSheet 2に日付を条件として...

えん - 22/1/8(土) 13:46 -


	引用なし

	パスワード

▼マナさん：
Sheet1にマクロボタンを設置して作動させたのですが、testの方はA列2行目移行が空白に、B列2行目移行は今回は空欄でした。
test2の方は「型が一致しません」というエラーメッセージがでました。

Excel初心者のため、お手を煩わせてしまい申し訳ございません、、、

・ツリー全体表示


	【81899】Re:Sheet1からSheet 2に日付を条件として...

マナ - 22/1/8(土) 12:13 -


	引用なし

	パスワード

▼えんさん：

Sheet1に、

＞マクロボタンを設置

つまり、Sheet1が、アクティブな状態で実行する前提のマクロです。

・ツリー全体表示


	【81898】Re:Sheet1からSheet 2に日付を条件として...

えん - 22/1/8(土) 12:02 -


	引用なし

	パスワード

▼マナさん：
test()とtest2の両方

>Set r1 = Worksheets("Sheet1").Cells(2).CurrentRegion
>　　　　↓
>Set r1 = Cells(1).CurrentRegion
>Set r1 = Intersect(r1, r1.Offset(, 1))

に差し替えて試したのですが、まずtestの方はA列の2行目から下が空白になり、B列2行目からシリアル値(おそらく一年分)が入力されました。
つぎにtest２の方は

実行時エラー'1004'
「この選択は適切ではありません。コピー領域と貼り付け領域が同じサイズかつ同じ形状ではない場合は、それらの領域が重ならないようにしてください。

というエラーメッセージがでました。

・ツリー全体表示


	【81897】Re:Sheet1からSheet 2に日付を条件として...

マナ - 22/1/8(土) 10:03 -


	引用なし

	パスワード

▼えんさん：

Set r1 = Worksheets("Sheet1").Cells(2).CurrentRegion
　　　　↓
Set r1 = Cells(1).CurrentRegion
Set r1 = Intersect(r1, r1.Offset(, 1))

・ツリー全体表示


	【81896】Re:Sheet1からSheet 2に日付を条件として...

えん - 22/1/8(土) 9:52 -


	引用なし

	パスワード

▼マナさん：
いえ、sheetのタイトル名や説明書き、マクロボタンを設置しようと思っています。

・ツリー全体表示


	【81895】Re:Sheet1からSheet 2に日付を条件として...

マナ - 22/1/8(土) 9:14 -


	引用なし

	パスワード

▼えんさん：

Sheet1のA列はすべて空白でしょうか

・ツリー全体表示


	【81894】Re:Sheet1からSheet 2に日付を条件として...

えん - 22/1/8(土) 8:09 -


	引用なし

	パスワード

マナさん
ありがとうございます。

test1の方はSheet2のA列が2行目から下が消えてしまい、数値の入力はされてませんでした。
test2の方は型が一致しませんというエラーメッセージが表示されました。

VBA初心者で申し訳ないのですが、よろしくお願い致します。

・ツリー全体表示


	【81893】Re:Sheet1からSheet 2に日付を条件として...

マナ - 22/1/7(金) 22:28 -


	引用なし

	パスワード

▼えんさん：
Sub test2()
　　Dim r1 As Range, r2 As Range
　　Dim r As Range, m as Long

　　Set r1 = Worksheets("Sheet1").Cells(2).CurrentRegion
　　Set r2 = Worksheets("Sheet2").Cells(1).CurrentRegion
　　
　　For Each r In r1.Rows
　　　　m = Application.Match(r.Cells(1), r2.Rows(1), 0)
　　　　r.Copy
　　　　r2.Cells(1, m).PasteSpecial xlPasteValues, Transpose:=True
　　Next
　　Application.CutCopyMode = False

End Sub

・ツリー全体表示


	【81892】Re:Sheet1からSheet 2に日付を条件として...

マナ - 22/1/7(金) 20:33 -


	引用なし

	パスワード

▼えんさん：

Option Explicit

Sub test()
　　Dim r1 As Range, r2 As Range
　　Dim gyo, retu

　　Set r1 = Worksheets("Sheet1").Cells(2).CurrentRegion
　　Set r2 = Worksheets("Sheet2").Cells(1).CurrentRegion
　　Set r2 = r2.Offset(1).Resize(r1.Columns.Count - 1)
　　
　　gyo = Evaluate("row(2:" & r1.Columns.Count & ")")
　　retu = Application.Match(r2.Rows(0), r1.Columns(1), 0)

　　r2.Value = Application.Index(Application.Transpose(r1), gyo, retu)
　　On Error Resume Next
　　r2.SpecialCells(xlCellTypeConstants, xlErrors).ClearContents

End Sub

・ツリー全体表示


	【81891】Sheet1からSheet 2に日付を条件として数...

えん - 22/1/7(金) 16:37 -


	引用なし

	パスワード

Sheet1(Blank)のB列に日付が入力されており。その横のC～AA列までその日の数値が入力されます。
Sheet2(BIO)の1行目に一年分の日付が入力されているのですが、そこの日付と同じSheet1(Blank）の日付の行の数値を転記するようにしたいです。
Sheet2はSheet1の日付と項目欄を縦横逆にしただけです。
イメージ的には各シートは以下のようになっています。

Sheet1(Blank)
　　　　B列　　C列　　D列・・・AA列
1行目　　日付　温度　　温度　　電流
2行目　　1/1　　20　　　33　　　　5
3行目　　1/8　　30　　　20　　　　6

Sheet2(BIO)
　　　　A列　　B列　　C列　・・・NB列
1行目　　日付　 1/1　　1/2　・・・12/31　　　　
2行目　　温度　 20　　　30　　　　　
3行目　　温度　 1/8　　 30　　　　　
4行目　　電流　　5　　　 6

VBAで作動できるようにできますと、非常に助かります。
よろしくお願い致します。

・ツリー全体表示


	【81890】所定フォームへの流し込み

ackkn - 21/12/18(土) 8:20 -


	引用なし

	パスワード

行き詰まり、時間が無く困っています。無理なのかなとも思い始めましたが、どなたかご教示ください。配送管理をやっています。　毎年年末になると、荷主様から主要配送先への送り込み予定データが送られてきます。それを、得意先、センター毎に品目、品名、数量をまとめます。ここまでは何とか自力で出来たのですが、最後にこの表から配送スケジュール表への落とし込みで行き詰まりました。そのまとめた表が、下の表です。日付　　　曜日　得意先　センター名　ケース数　パレット数　総数（kg） 2021/12/18(火)　　　　A社　　　　Aセンター　　　　1,153　　　　8　　　　　3,800 2021/12/16(木)　　　　A社　　　　Aセンター　　　　1　　　　1　　　　　100 2021/12/18(土)　　　　A社　　　　Aセンター　　　　1　　　　1　　　　　100 2021/12/23(木)　　　　A社　　　　Aセンター　　　　197　　　　2　　　　　700 2021/12/24(金)　　　　A社　　　　Aセンター　　　　2,442　　　　20　　　　　9,900 2021/12/18(土)　　　　A社　　　　Bセンター　　　　1,243　　　　9　　　　4,100 2021/12/24(金)　　　　A社　　　　Bセンター　　　　1,874　　　　14　　　　6,300 2021/12/24(金)　　　　A社　　　　Cセンター　　　　255　　　　5　　　　2,600 2021/12/24(金)　　　　A社　　　　Dセンター　　　　109　　　　3　　　　1,100 この表を元に、下の所定表（13日～30日で固定）に変換したいのです。得意先　センター名　13日 14日 15日 16日 17日 18日 19日20日21日22日 23日　24日以降30日迄続く　　　　　　　曜日　(月) (火) (水) (木) (金) (土) (日)(月)(火)(水) (木) (金) ――――――――――――――――――――――――――――――――――――――― A社　　Aセンター　　　　1,153 8　　1 　1　　1　 1　　　　　　　　 197 2 2,442 20 　　　　　　　　　　　　3,800　　　100　　　100　　　　　　　　　　700　9,900　　　　 ――――――――――――――――――――――――――――――――――――――― A社　　Bセンター　　　　　　　　　　　　　 1,243 9　　　　　　　　　　　1,874 14 　　　　　　　　　　　　　　　　　　　　　　4,100　　　　　　　　　　　 6,300 ――――――――――――――――――――――――――――――――――――――― A社　　Cセンター　　　　　　　　　　　　　　　　　　　　　　　　　　　　255　 5 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　2,600　　　　 ――――――――――――――――――――――――――――――――――――――― A社　Dセンター　　　　　　　　　　　　　　　　　　　　　　　　　　　　　109　3 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　1,100 ――――――――――――――――――――――――――――――――――――――― 各日の欄は｜　　　　　｜ ――――――――――― 　　　　　｜1,153｜　8｜ ――――――――――― 　　　　　｜　　 3,800｜ ――――――――――― このように3つの欄で、上段がケース数とパレット数で、下段が総数kgです。この3つの欄がネックになっています。よろしくご教示ください。

・ツリー全体表示


	【81889】vbaでウインドウス10で以前のverでは値に...

ノボル

- 21/12/2(木) 20:06 -


	引用なし

	パスワード

vbaでウインドウス10で以前のverでは値になっていたが今＃NAME?と出る数値にするには VBAはFunctionで計算している Function KA(C!, Gam!, rHo1!, sHo1!, fai1!, der!, aru1!, sit!) As Single 'Function KA(C!, Gam!, rHo!, sHo!, fai!, der!, aru!, sit!) As Single Dim CC1 As Single Dim CC2 As Single Dim CC3 As Single Dim RC1 As Single fai = fai1 / 180 * 3.1415 'φ　ﾗｼﾞｱﾝ der = der / 180 * 3.1415 'δ aru = aru1 / 180 * 3.1415 'α sit = sit / 180 * 3.1415 'θ '1.ok CC1 = (Cos(fai1 - sit)) ^ 2 'cos(φ-θ）^2 '*********************************************************************** '2.ok CC2 = (Cos(sit)) ^ 2 * Cos(sit + der) '分母-1 cosθ＾2*cos（θ+δ） 'ﾃﾞｰﾀ条件 RC1 = Sin(fai1 - aru1) If fai1 < aru1 Then RC1 = 0 '3. CC3 = (1 + ((Sin(fai1 + der) * RC1) / (Cos(sit + der) * Cos(sit - aru1))) ^ 0.5) ^ 2 '{1+√（（sin(φ+δ）*sin(φ-α））/(（cos(θ+δ）*cos（θ-α））}^2 KA = CC1 / (CC2 * CC3) 'ka=cc1/(cc2*cc3) End Function

・ツリー全体表示


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

29 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free