Excel VBA質問箱 IV

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

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


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

240 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【77640】Re:VBA　画像圧縮

マナ - 15/11/15(日) 21:11 -


	引用なし

	パスワード

▼SEWING11 さん：
> 具体的には一同挿入した画像を一度コピーし、再度貼り付ける・・・という動作かなと考えているのですが、マクロの記憶では記録されず・・・困っております。

>
>上記に.CUT　などを書き足せばよいのか・・・

マクロ記録の結果です。
Selection.Cut
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False

・ツリー全体表示


	【77639】Re:VBA　画像圧縮

β - 15/11/15(日) 17:17 -


	引用なし

	パスワード

▼SEWING11 さん：

>目的は画像のファイルサイズ圧縮なので、このままでは圧縮されないですよね？

画像ファイルという意味が、画像がベタベタ、大きなサイズで多数貼り付けられているものをいっておられるとすれば
ご紹介した処理での加工で、サイズ圧縮はされます。

たとえば、なにもせずにどんどん元の大きさのままで張り付けると10メガ程度のブックサイズになるケースで
このコードで実行しますと2メガ程度に小さくなりました。

画像ファイルというのが、もともとフォルダにある画像ファイルのことをいっていられるとすれば
このコードではだめですね。
というか、もし、そうなら、エクセルに取り込む前に（あるいは取り込み時点で）
画像ファイルそのものを圧縮したものを取り込むことが必要ですね。

・ツリー全体表示


	【77638】Re:VBA　画像圧縮

SEWING11 - 15/11/15(日) 16:02 -


	引用なし

	パスワード

回答ありがとうございます。
ご指摘の通り途中、挿入先のセルに画像が残っていた場合は削除する。という記述を省略したので、中途半端に載せてしまいすみませんでした。

参照先を確認しました。
セル内へサイズの圧縮を行って挿入する記述ですね。参考にいたします。

目的は画像のファイルサイズ圧縮なので、このままでは圧縮されないですよね？
もう少し検索して模索します。
ありがとうございました。

・ツリー全体表示


	【77637】Re:VBA　画像圧縮

β - 15/11/15(日) 6:10 -


	引用なし

	パスワード

▼SEWING11 さん：

>現在の写真帳の構文は

現在のコードから取捨選択して必要と思われる部分をアップしたんでしょうね。
ぽつんと Next が残っていたりしますので。

アップされたコードの手直しではなく、別の板ですがほぼ同じ要件で投稿したコードがあります。
//www.excel.studio-kazu.jp/kw/20151106133015.html
この中の　（β） 2015/11/07(土) 12:32　のコードが参考になりませんか？

・ツリー全体表示


	【77636】VBA　画像圧縮

SEWING11 - 15/11/14(土) 22:45 -


	引用なし

	パスワード

お世話になります。
OKweb様へも質問しましたが回答がつかないので・・・

エクセル２０１０を使用しています。写真帳を作成しダブルクリックすれば写真が挿入されるようVBAにて作成しましたが、写真の解像度が高いので挿入するたびに画像が圧縮するようにVBAを組みたいのですが、どなたかご教示ください。
具体的には一同挿入した画像を一度コピーし、再度貼り付ける・・・という動作かなと考えているのですが、マクロの記憶では記録されず・・・困っております。

現在の写真帳の構文は
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)

Dim myF As Variant
Dim mySp As Object
Dim myAD1 As String
Dim myAD2 As String
Dim myHH As Double
Dim myWW As Double
Dim myHH2 As Double
Dim myWW2 As Double

'挿入のセルを指定

If Application.Intersect(Target, Range("d6,d23,d40")) Is Nothing Then Exit Sub
Cancel = True
Application.ScreenUpdating = False

End If

'写真挿入

Next
myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
If myPic = False Then
MsgBox "画像を選択してください"

Exit Sub

End If

Set myRange = Target 'このセル範囲に収まるように画像を縮小する
Application.ScreenUpdating = False
With ActiveSheet.Shapes.AddPicture(myPic, False, True, myRange.Left, myRange.Top, myRange.Width, myRange.Height)

rX = 0.85
rY = 1

If rX > rY Then
.Height = .Height * rY
Else
.Width = .Width * rX

End If
.Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
.Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
.ZOrder msoSendToBack '最背面へ移動

End With
Application.ScreenUpdating = True
Cancel = True

End Sub

上記に.CUT　などを書き足せばよいのか・・・
→エラーばかりで動かなったので。。
　こちらに質問することにしました。
どうぞ、よろしくお願いします。

・ツリー全体表示


	【77635】Re:【Excel】経理の表について

β - 15/11/13(金) 19:46 -


	引用なし

	パスワード

▼かおさん：

今後はルールを守っていただくとして。

レイアウト、不明なところもありますが、
A列が案件、B列が開始日、C列が終了日、D列から右に月（データとしては日付型。表示形式で m月になっている）
１行目がタイトル行、２行目からデータということにしています。
按分計算の結果でてきた計算誤差については最終月で調整しています。

Sub Test()
　　Dim c As Range
　　Dim dic As Object
　　Dim v As Variant
　　Dim n As Long
　　Dim x As Long
　　Dim d As Date
　　Dim f As Long
　　Dim t As Long
　　Dim days As Long
　　Dim tot As Long
　　Dim amt As Long
　　
　　Set dic = CreateObject("Scripting.Dictionary")
　　
　　With Range("A1").CurrentRegion
　　　　ReDim v(1 To .Rows.Count - 1, 1 To .Columns.Count - 4)
　　　　For Each c In .Rows(1).Offset(, 4).Resize(, .Columns.Count - 4).Cells
　　　　　　dic(Format(c.Value, "yyyymm")) = dic.Count + 1
　　　　Next
　　　　For Each c In .Columns(1).Offset(1).Resize(.Rows.Count - 1).Cells
　　　　　tot = 0
　　　　　　days = DateDiff("d", c.Offset(, 1).Value, c.Offset(, 2).Value) + 1
　　　　　　n = DateDiff("m", c.Offset(, 1).Value, c.Offset(, 2).Value) + 1
　　　　　　d = c.Offset(, 1).Value
　　　　　　For x = 1 To n
　　　　　　　　If n = 1 Then
　　　　　　　　　　f = Day(c.Offset(, 1).Value)
　　　　　　　　　　t = Day(c.Offset(, 2).Value)
　　　　　　　　Else
　　　　　　　　　　If x = 1 Then
　　　　　　　　　　　　f = Day(c.Offset(, 1).Value)
　　　　　　　　　　　　t = Day(DateSerial(Year(c.Offset(, 1).Value), Month(c.Offset(, 1).Value) + 1, 0))
　　　　　　　　　　ElseIf x = n Then
　　　　　　　　　　　　f = 1
　　　　　　　　　　　　t = Day(c.Offset(, 2).Value)
　　　　　　　　　　Else
　　　　　　　　　　　　f = 1
　　　　　　　　　　　　t = Day(DateSerial(Year(d), Month(d) + 1, 0))
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　
　　　　　　　　amt = c.Offset(, 3).Value * (t - f + 1) / days
　　　　　　　　If x = n Then amt = c.Offset(, 3).Value - tot
　　　　　　　　tot = tot + amt
　　　　　　　　If dic.exists(Format(d, "yyyymm")) Then
　　　　　　　　　　v(c.Row - 1, dic(Format(d, "yyyymm"))) = amt
　　　　　　　　End If
　　　　　　　　
　　　　　　　　d = DateAdd("m", 1, d)

　　　　　　Next
　　　　Next
　　End With
　　
　　Range("E2").Resize(UBound(v, 1), UBound(v, 2)).Value = v
　　
End Sub

・ツリー全体表示


	【77634】Re:【Excel】経理の表について

β - 15/11/13(金) 18:17 -


	引用なし

	パスワード

▼かおさん：

質問箱ではマルチを容認しています。
していますが、「ルール」があります。

本サイトの基本方針をまとめました。こちらをご一読ください。

というところの　こちら　をクリックしてみてください。

・ツリー全体表示


	【77633】【Excel】経理の表について

かお - 15/11/13(金) 17:30 -


	引用なし

	パスワード

Excel初心者です。
・・・・・・・・・・・・・・・・・・・・・・・・・
　契約開始　契約終了　契約金額　１0月　１1月
A
B
C
・・・・・・・・・・・・・・・・・・・・・・・・・
上記のような表を作成しているのですが、
契約開始が、2015/10/30
契約終了が、2015/11/21
といったように、契約期間によっては月がまたがることがあります。

その場合に、契約金額を入力したら、
「2015/10/30～2015/31」までの契約金額の「日割りの合計」
「2015/11/1～2015/11/21」までの契約金額の「日割りの合計」
が、「１0月」「１1月」の欄に出てくるようにしたいのですが、可能でしょうか？

・・・・・・・・・・・・・・・・・・・・・・・・・
【例】契約期間：2015/10/30～2015/11/2
　　　契約金額：10000円
　　　↓
　　　１０月：5000円　（2500円×2）
　　　１１月：5000円　（2500円×2）
・・・・・・・・・・・・・・・・・・・・・・・・・

説明が分かりにくくてすみませんが、分かる方いましたらご回答お願いします。

・ツリー全体表示


	【77632】Re:VBA初心者

ウッシ - 15/11/12(木) 14:37 -


	引用なし

	パスワード

追記

どこまで求められているか分からないですけど、
不正な引数とか、行列範囲以外の数値とか判定するための
エラー処理は別途必要です。

・ツリー全体表示


	【77631】Re:VBA初心者

ウッシ - 15/11/12(木) 14:32 -


	引用なし

	パスワード

こんにちは

英文を最初に記載しておいた方が良かったですね。

βさんも書かれていますが、引数「row」の意味が分かりにくいですが、

「with data」という表現からすると、1000行目、1列という意味で指定する
ような意味合いではないでしょうか？

つまり判定範囲がセルA1～A1000という。

一般的に最終行は下から探すので、シートの最大行数を使います。

課題としてはsubからfunctionを呼び出せとなっているので、

Sub test_sub()
'1列目の1000行目から調べて最初の値の行を表示する
　　MsgBox test_function(1000, 1)
End Sub
Function test_function(r As Long, c As Long) As Variant
　　Dim i As Long
　　test_function = ""
　　For i = r To 1 Step -1
　　　　If Cells(i, c) <> "" Then
　　　　　　test_function = i
　　　　　　Exit For
　　　　End If
　　Next
End Function

と答えた方がいいでしょうね。

但し、rowを指定する意味は教授に確認した方がいいと思います。

・ツリー全体表示


	【77630】Re:VBA初心者

β - 15/11/12(木) 14:13 -


	引用なし

	パスワード

▼井上さん：

厳しいコメントになるかもしれませんが・・・・

>おそらく、そのような答えを教授が求めていると思います。
>本当に有難うございましたm－ーm

そうじゃないですね。
ウッシさんは、そもそも、そちらの要件提示があやふやだったので、
求めるのもは値かなと、そう解釈されてコードをアップしておられますが
課題は　「returns the row number of the last row with data 」ですから
値ではなく行番号を返さなくてはいけません。

ウッシさんにいただいたコードを、そのまま教授に提出すると、当然ながら
【赤点】ですね。（もちろん、ウッシさんのせいではなく、井上さんのせいです）

>英語でかかれてある問題を日本語に訳したら、VBAに詳しい人は理解してくれるだろう

まったくの思い違いです。
百歩譲って、【井上さんが正しく訳したら】回答側でも、想像できるところはあるでしょう。
でも、課題は、【与えられた列や行の情報から、その列の最終・・・・・】ということですよね。

説明するなら、まずそれを明記した上で、たとえば、1列目が与えられたとして、その時 A列が
こうこうこういった状態なら、そこの、何を返したいという例示。
こうすべきです。

だけど、井上さんは A列に　こうこういったデータがある。そこに　列と行を与えて云々という
説明をしましたよね。説明の順序とポイントが間違っているわけです。

これも、ＶＢＡがどうこういう問題ではなく、意思疎通の課題、大人としての基本的な能力の
問題です。

さて、列はわかりましたが、まだ【行】の役割が見えません。
井上さんは見えていますか？　見えているなら、その役割を説明しなければいけません。
繰り返します。これはＶＢＡの問題ではありません。物事の解釈・理解の問題です。

で、もし、井上さんも、この行の役割がわからない、ということなら、井上さんが
教授に質問しなければいけません。で、教授の見解を回答者に連絡しなければいけません。

もし、井上さんが、この行の役割に対して何の疑問も持っていないとすれば
それはそれで、問題ですねぇ。

・ツリー全体表示


	【77629】Re:VBA初心者

井上 - 15/11/12(木) 12:52 -


	引用なし

	パスワード

本当におっしゃる通りだと思います。
私のVBAに関する知識は本当に乏しいもので、英語でかかれてある問題を日本語に訳したら、
VBAに詳しい人は理解してくれるだろうという浅はかな考えで投稿してしまい、本当にご迷惑をおかけいたしました。今度は問題を理解してから質問出来るようにしたいと思います。

▼β さん：
>▼井上さん：
>
>>実は、Functionがうまく使えるかどうかの海外の大学の課題なのです。なので、私も全く無意味だと思いますが、課題なのでこの通りにしなければいけないんですよね
>
>課題がどこか変だとして、でも、それが課題だから、それにそって答えなければいけないとして
>でも、その課題がどういうものかは、質問者さんは理解しているわけですよね？
>その理解している課題の内容を、回答がほしいということなら、回答者にきちんと伝えなければいけませんね。
>
>課題そのものが、何を言っているのかわからない、矛盾があると、そう思っているなら
>それを示しても、回答者は困りますよね。
>
>課題が何なのか、これをきちんと伝える、それが第一歩ではないですか？
>
>A列に値があるとします。
>で、Functionプロシジャに　「列」と「行」をあたえて「何か」をさせるのですよね？
>たとえば、「列」として 5(E列)、「行」として　20 が与えられたとします。
>このFunctionプロシジャは、与えられた 5 と 20 から A列の何をどうするのですか？
>
>それって、なんだかおかしいとは思いませんか？
>で、課題で出しているくらいだから、そんな、矛盾した課題ではないはずですね。
>ということは、その課題の伝え方が正しくないということになりませんか？

・ツリー全体表示


	【77628】Re:VBA初心者

井上 - 15/11/12(木) 12:49 -


	引用なし

	パスワード

分かりにくい私の説明の中、親切にご返答してくださり有難うございます。
課題は英文なんです。。
↓

Write a function that receives a row number and a column number, finds the last row with data in that column, and returns the row number of the last row with data to the calling sub. Write a sub to test the function and display the number of the last row with data.

おそらく、そのような答えを教授が求めていると思います。

本当に有難うございましたm－ーm

▼ウッシさん：
>こんにちは
>
>課題が英文なんでしょうか？
>
>想像で、
>
>Function test(r As Long, c As Long) As Variant
>'=test(1000,1)とすると
>'1列目の1000行まで調べて最後の値を表示する
>　　Dim i As Long
>　　test = ""
>　　For i = 1 To r
>　　　　If Cells(i, c) = "" Then
>　　　　　　Exit For
>　　　　End If
>　　　　test = Cells(i, c)
>　　Next
>End Function
>
>こんな事でしょうか？

・ツリー全体表示


	【77627】Re:VBA初心者

ウッシ - 15/11/12(木) 11:26 -


	引用なし

	パスワード

こんにちは

課題が英文なんでしょうか？

想像で、

Function test(r As Long, c As Long) As Variant
'=test(1000,1)とすると
'1列目の1000行まで調べて最後の値を表示する
　　Dim i As Long
　　test = ""
　　For i = 1 To r
　　　　If Cells(i, c) = "" Then
　　　　　　Exit For
　　　　End If
　　　　test = Cells(i, c)
　　Next
End Function

こんな事でしょうか？

・ツリー全体表示


	【77626】Re:VBA初心者

β - 15/11/12(木) 10:30 -


	引用なし

	パスワード

▼井上さん：

>実は、Functionがうまく使えるかどうかの海外の大学の課題なのです。なので、私も全く無意味だと思いますが、課題なのでこの通りにしなければいけないんですよね

課題がどこか変だとして、でも、それが課題だから、それにそって答えなければいけないとして
でも、その課題がどういうものかは、質問者さんは理解しているわけですよね？
その理解している課題の内容を、回答がほしいということなら、回答者にきちんと伝えなければいけませんね。

課題そのものが、何を言っているのかわからない、矛盾があると、そう思っているなら
それを示しても、回答者は困りますよね。

課題が何なのか、これをきちんと伝える、それが第一歩ではないですか？

A列に値があるとします。
で、Functionプロシジャに　「列」と「行」をあたえて「何か」をさせるのですよね？
たとえば、「列」として 5(E列)、「行」として　20 が与えられたとします。
このFunctionプロシジャは、与えられた 5 と 20 から A列の何をどうするのですか？

それって、なんだかおかしいとは思いませんか？
で、課題で出しているくらいだから、そんな、矛盾した課題ではないはずですね。
ということは、その課題の伝え方が正しくないということになりませんか？

・ツリー全体表示


	【77625】Re:VBA初心者

井上 - 15/11/12(木) 9:29 -


	引用なし

	パスワード

ウッシさん

ご返答有難うございます。
実は、Functionがうまく使えるかどうかの海外の大学の課題なのです。なので、私も全く無意味だと思いますが、課題なのでこの通りにしなければいけないんですよね。。自分で試行錯誤したのですが、全くダメでした。。

行列には、
31
75
53
23
47
39
24
23
63
19

が入ります。そして、Functionキーを使い（For loopを使ってだと思うんのですが。。）レンジがA10に到達したときに答えである数字（１９）をサブに呼び出してメッセージ表示したいのです。

私もこのクラスを取る前にVBAの知識が無く、説明がわかりにくく大変申し訳御座いません。

▼ウッシさん：
>こんにちは
>
>>そして、行(row)数字と列(column)数字を受け取るFunction
>
>具体的に行列にはどんな数字が入るのですか？
>
>与えられた1つの行と1つの列に
>>最後の行に入力してある数字
>つまりＡ10の数字があるか見つけて、その数字をメインに渡す。
>
>って、無意味では？
>
>セルＡ10の数字そのものでは？
>
>多分意味が違うのでしょうけど、質問を他の人に分かりやすく
>書き直した方がいいと思います。
>
>
>▼井上さん：
>>初めて投稿させてもらいます。質問なんですが、
>>A1からA10までランダムな数字を入力してあるとします。
>>そして、行(row)数字と列(column)数字を受け取るFunctionプロシージャーを作成します。その中に最後の行に入力してある数字を見つけます。そしてその数字をメインsubに呼び出し、Msgboxに表示させたいのですが、方法が分かりません。どなたかお助けお願い申し上げます。
>>説明が下手で申し訳御座いません。

・ツリー全体表示


	【77624】Re:VBA初心者

ウッシ - 15/11/12(木) 9:10 -


	引用なし

	パスワード

こんにちは

>そして、行(row)数字と列(column)数字を受け取るFunction

具体的に行列にはどんな数字が入るのですか？

与えられた1つの行と1つの列に
>最後の行に入力してある数字
つまりＡ10の数字があるか見つけて、その数字をメインに渡す。

って、無意味では？

セルＡ10の数字そのものでは？

多分意味が違うのでしょうけど、質問を他の人に分かりやすく
書き直した方がいいと思います。

▼井上さん：
>初めて投稿させてもらいます。質問なんですが、
>A1からA10までランダムな数字を入力してあるとします。
>そして、行(row)数字と列(column)数字を受け取るFunctionプロシージャーを作成します。その中に最後の行に入力してある数字を見つけます。そしてその数字をメインsubに呼び出し、Msgboxに表示させたいのですが、方法が分かりません。どなたかお助けお願い申し上げます。
>説明が下手で申し訳御座いません。

・ツリー全体表示


	【77623】VBA初心者

井上 - 15/11/12(木) 7:34 -


	引用なし

	パスワード

初めて投稿させてもらいます。質問なんですが、
A1からA10までランダムな数字を入力してあるとします。
そして、行(row)数字と列(column)数字を受け取るFunctionプロシージャーを作成します。その中に最後の行に入力してある数字を見つけます。そしてその数字をメインsubに呼び出し、Msgboxに表示させたいのですが、方法が分かりません。どなたかお助けお願い申し上げます。
説明が下手で申し訳御座いません。

・ツリー全体表示


	【77622】Re:マクロ化の検討

VBAビギナー - 15/11/11(水) 8:40 -


	引用なし

	パスワード

βさん
回答ありがとうございます。
VBAでの例も大変参考になりました。
プログラムに美しさすら感じます。
本当にありがとうございました。

・ツリー全体表示


	【77621】Re:マクロ化の検討

VBAビギナー - 15/11/11(水) 8:36 -


	引用なし

	パスワード

独覚さん

早速の回答ありがとうございます。
VBAではなく関数だけで、複雑な処理ができることに驚きました。
関数にも興味が持てたので、これから精進してまいります。

・ツリー全体表示


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

240 / 3841 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free