VBAプログラム作成のお世話になったサイト
自分のメモ用 今後も追加予定
セルの分割 ・dengel.exblog.jp
リストボックスの使い方 ・個人的に便利なやりかた ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Dim ReadRange As String Dim Last_Row As Integer Last_Row = Cells(Rows.Count, "A").End(xlUp).Row ReadRange = "A1:" + Cells(Last_Row, 4).Address(False, False) With Me.ListBox1 .ColumnCount = 4 .List = Range(ReadRange).Value End With ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Last_RowはA列最後の値を読みこむために宣言している ColumnCountは列の数
Outlookのメールをエクセルに張り付ける
作成したプログラムを残すためにこの記事を書きました。
プログラム作成した際にお世話になりました。 １．VBAでoutlookのメールの内容を取得しているのですが、最新のメールのみを取得したい場合どのようにすれば良いでしょうか？ detail.chiebukuro.yahoo.co.jp
２．エクセルVBAでOutlookの受信メールをワークシートに書き出す方法 tonari-it.com
がお世話なりました。
１．VBAでoutlookのメールの内容を取得しているのですが、最新のメールのみを取得したい場合どのようにすれば良いでしょうか？ のプログラムを基準にプログラムを実行してみたところ Debug.Print .SenderName, .ReceivedTime, .Subject ではエクセルに張り付けることができない
そのため、 ２．エクセルVBAでOutlookの受信メールをワークシートに書き出す方法 のプログラムを参考に、エクセルにデータを張り付ける With ThisWorkbook.Worksheets("Sheet1") .Cells(2, 1).Value = myInbox.Items(1).SentOn .Cells(2, 2).Value = myInbox.Items(1).Subject .Cells(2, 3).Value = myInbox.Items(1).Body End With
結果的に以下のプログラムになった。 ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー Sub GetMail() Dim outlookObj As Object Dim myNameSpace As Object Dim objmailItem As Object Dim objmailItems As Object Dim SubFolder As Object Dim Target_mail As String Set outlookObj = CreateObject("Outlook.Application") Set myNameSpace = outlookObj.GetNamespace("MAPI") Set SubFolder = myNameSpace.GetDefaultFolder(6) '.Folders("").Folders("○○○○") Set objmailItems = SubFolder.Items objmailItems.Sort "[受信日時]", True 'False(昇順),True(降順) Set objmailItem = objmailItems(1) With objmailItem Cells(2, 1).Value = .SentOn Cells(3, 1).Value = .Subject Cells(4, 1).Value = .Body End With End Sub ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
最新のメールのみならず、目的の件名を探したいプログラムを付けたいと思い以下のものを作成した。 使用方法はA1に目的の件名を入力し、プログラムを実行する。 ーーーーーーーーーーーーーーーーーーーーーーーーー Sub GetMail2() Dim outlookObj As Object Dim myNameSpace As Object Dim objmailItem As Object Dim objmailItems As Object Dim SubFolder As Object Dim Target_mail As String Set outlookObj = CreateObject("Outlook.Application") Set myNameSpace = outlookObj.GetNamespace("MAPI") Set SubFolder = myNameSpace.GetDefaultFolder(6) '.Folders("").Folders("○○○○") Set objmailItems = SubFolder.Items objmailItems.Sort "[受信日時]", True 'False(昇順),True(降順) Target_mail = Range("A1").Value For i = 1 To 10 Set objmailItem = objmailItems(i) If objmailItem.Subject = Target_mail Then With objmailItem Cells(2, 1).Value = .SentOn Cells(3, 1).Value = .Subject Cells(4, 1).Value = .Body End With End If Next End Sub ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
食塩濃度計算サイト
塩分濃度計算
水の量・塩の量・食塩濃度をそれぞれ計算します
詳しい式は下にあります
塩分濃度等計算エリア
水の量
食塩の量
食塩濃度
使用方法
（１）水の量・食塩の量・食塩濃度の内2つを入力
（２）求めたいものの計算をクリック
（３）結果が表示されます
計算式
水の量の計算式
水の量=（食塩の量/食塩濃度×100）-食塩の量
食塩の量の計算式
食塩の量=水の量×食塩濃度/（100-食塩濃度）
食塩濃度の計算式
食塩濃度=100×食塩の量/（食塩の量＋水の量）
歩留まり率計算サイト
歩留まり率計算サイト
製造業向け？良品・不良品・製造合計数から歩留まり率を計算します
注意：僕が計算方法勘違いしているかもしれないので、計算式を確認してから使用して下さい！
こういう機能が欲しい等の意見があれば言って下さい(੭ु´･ω･`)੭ु⁾⁾
歩留まり率計算
良品
不良品
製造合計数
計算結果
使用方法
（１）良品・不良品・製造合計数の内2つを入力
（２）計算をクリック
（３）結果が表示されます
計算式
良品が空欄の時
歩留まり率(%)=(製造合計数-不良品)/製造合計数×100
不良品が空欄の時
歩留まり率(%)=良品/製造合計数×100
製造合計数が空欄の時
歩留まり率(%)=良品/(良品+不良品)×100
Excel VBA 範囲のコピー(応用)
自分用にVBAのメモ
意見やアドバイスがあれば教えてください。
なんなら参考にしてくれたら嬉しいです。(コメントくれたら喜ぶかも)
セルの範囲をコピーする方法(基本)
A1～B101の範囲にあるデータをC1～D101に張り付ける場合以下のプログラムになる
ーーーーーーーーーーーーーーーーーー
Sub CopyRange1()
Dim CopyRange As Variant
CopyRange = Worksheets(1).Range("A1:B101").Value 'A1～B101の範囲の値をCopyRangeにする
Worksheets(1).Range("C1:D101") = CopyRange 'CopyRangeに指定した範囲の値をC1～D101に代入する
End Sub
ーーーーーーーーーーーーーーーーーー
このプログラムで範囲のコピーが可能
このプログラムのデメリットとして、
"A1:B101"や"C1:D101"のように決まった範囲しか行うことができない！
コピーする列も行も決まっていない時
"〇:〇"内の変数に変えればできる
そのため、以下のように書くとエクセル上で入力で変更することができる
ーーーーーーーーーーーーーーーーーー
Sub CopyRange2()
Dim CopyRange As Variant
'コピーするものを入れる変数
Dim CopyRangeCP As String
Dim CopyRangeCE As String
Dim CopyRangeCT As String
'貼り付けるものを入れる変数
Dim CopyRangePP As String
Dim CopyRangePE As String
Dim CopyRangePT As String
CopyRangeCP = Worksheets("Sheet1").Range("A1").Value
CopyRangeCE = Worksheets("Sheet1").Range("A2").Value
CopyRangeCT = CopyRangeCP + ":" + CopyRangeCE
CopyRangePP = Worksheets("Sheet1").Range("A3").Value
CopyRangePE = Worksheets("Sheet1").Range("A4").Value
CopyRangePT = CopyRangePP + ":" + CopyRangePE
CopyRange = Worksheets("Sheet2").Range(CopyRangeCT).Value
Worksheets("Sheet2").Range(CopyRangePT) = CopyRange
End Sub
ーーーーーーーーーーーーーーーーーー
使用方法
・コピーしたい左上のセルをシート(Sheet1)のA1セルに入力
・コピーしたい右下のセルをシート(Sheet1)のA2セルに入力
・貼り付けたい左上のセルをシート(Sheet1)のA3セルに入力
・貼り付けたい左上のセルをシート(Sheet1)のA4セルに入力
・コピーして貼り付けたいセルをシート(Sheet2)に入力
入力例）
列が決まっていない時
コピー及び貼り付ける列(A列など)のセルが決まっていて列が決まっていない時
ーーーーーーーーーーーーーーーーーー
Sub CopyRange3()
Dim CopyRange As Variant
Dim CopyRangeColumn As Integer
Dim CopyRangeCT As String
Dim CopyRangePT As String
CopyRangeColumn = Worksheets("Sheet1").Range("A1").Value
CopyRangeCT = "A1:" + Cells(CopyRangeColumn, 2).Address(False, False)
CopyRangePT = "C1:" + Cells(CopyRangeColumn, 4).Address(False, False)
CopyRange = Worksheets("Sheet2").Range(CopyRangeCT).Value
Worksheets("Sheet2").Range(CopyRangePT) = CopyRange
End Sub
ーーーーーーーーーーーーーーーーーー
使用方法
・列をシート(Sheet1)のセルA1に入力
・コピーするデータをシート(Sheet2)のA1～B(Sheet1のA1で入力した数字)を入力
実行後は貼り付けたいデータをシート(Sheet2)のC1～D(Sheet1のA1で入力した数字)に出力
入力例）
出力）この値を入力した場合、Sheet2のA1～B101のデータを読み取り、
Sheet2のC1～D101に貼り付ける。
補足説明
・Cells(〇, 〇).Address(False, False)
Cellsで入力したデータをRangeで出力することができる
入力例）Cells(2, 1).Address(False, False)
出力）A2
ツムツム スキル上げ必要数
ツムツムをやっていたので、一覧で見れたらいいな～
あと何体で次のレベルまで上がるかな～
全部集めるまでどれくらいかな～
って感覚で作りました。現在(19/4/27)全キャラ入力しました。
HTMLやCSS(しばらく手抜き)、JavaScriptを独学したばかりです何かアドバイスを頂けるとありがたいです
