Excel VBA 質問スレ Part66

**1000** · 2020/05/10(日) 13:43:45.00

ExcelのVBAに関する質問スレです
コード書き込みや作成依頼もOK

※前スレ
Excel VBA 質問スレ Part65
https://mevius.5ch.net/test/read.cgi/tech/1584430040/

※デフォルト設定

**デフォルトの名無しさん** · 2020/06/07(日) 19:05:10.46

>>585
特殊以外だと、日本語環境で中国語とか。

**デフォルトの名無しさん** · 2020/06/07(日) 19:26:44.01

>>589
それ例ではスペースとかハイフン無いのに入力してエラーのパターンでは

**デフォルトの名無しさん** · 2020/06/07(日) 19:30:43.11

>>591
もしかしてカーソルが「止まる」とか言ってたのか？
想像以上に低レベルだったなw

**デフォルトの名無しさん** · 2020/06/07(日) 20:18:15.14

そういえばADOを使ったcsv取り込み機能でうちの業務システムから出力したcsvファイルを取り込んだらエラーが出たことあったな。
ファイル名変えたら取り込めたけど。

**デフォルトの名無しさん** · 2020/06/07(日) 20:32:18.62

>>594
>>592
オイオイ、♬みたいな奴だろ。
文字列変数で受けると?になっちまうんだ。

**582** · 2020/06/07(日) 20:50:04.89

ファイル名に?が入ったまま何かの処理をすればエラ―吐いて止まるというのは考えられる。

というか、何で俺が解説しなきゃならねえんだよ。
頼むぜw

**582** · 2020/06/07(日) 20:56:23.87

>>589
そいつはレベルが低いな。
スペースなんて正式な住所や氏名にはあり得ねえとして、入力したもんから片っ端から抜いちまう処理を入れるもんだ。

ハイフンはちょっとあり得る。
普通はマイナス使うと思うんだが罫線記号使ったり似たのがいっぱいあるからな。

**デフォルトの名無しさん** · 2020/06/07(日) 21:55:32.54

これだな

>Excel VBA 質問スレ Part43
>274 名前：デフォルトの名無しさん[] 投稿日：2016/12/02(金) 22:33:29.62 ID:rRSQCExt [1/2]
>ちょっと質問
>
>・おもむろにファイルエクスプローラを開く
>・なんでもいいからファイルのプロパティを開く
>・そこの作成日時をドラッグする
>・セルのA1にペーストする
>
>例えば　2013?年?12?月?1?日、??17:02:28
>これを(すでに文字化けしてると思うが)
>2013/12/1 17:02:28
>に整形したいんだけど
>どうすればいいんだ？
>半角に見えるけどサクラでみるとU+200Fとなっている
>中には数値の間にも混入しているのもある
>最初からFSOで取得するのは無しで
>すでに手動で取り込んだ数百件ものデータなんだ
>よろしくお願いします

**デフォルトの名無しさん** · 2020/06/07(日) 22:23:02.67

再現しないぞ

**デフォルトの名無しさん** · 2020/06/07(日) 22:44:34.20

>>598
そりゃ、住基ネットのデータベースが
インターネットからは参照不能で
全国の一般の素人が入力する事を想定した設計に無理があったんでしょ。

**デフォルトの名無しさん** · 2020/06/07(日) 23:18:32.86

前スレでここで教えて貰ったのが完成した
課のみんなのPCに入れて使いたいらしい
パス指定するタイプだから

・読取専用にする
・プロジェクトプロパティをロック
・C直下に置いてショートカットをデスクトップに置いてやる
・シート名は変えるなと徹底

こんだけ教えとけばまぁ大丈夫だよね？

**デフォルトの名無しさん** · 2020/06/07(日) 23:22:24.39

セルの行と列の変数名って業務でよく使うんだけど

Dim r As Long 　'行
Dim c As Long '列
これで癖付けてっていいですか？いいですよね？

**デフォルトの名無しさん** · 2020/06/07(日) 23:26:23.34

>>602
何が完成したのやら
レス番を貼るか概要を書いて貰わないとわからん

**デフォルトの名無しさん** · 2020/06/07(日) 23:35:39.43

>>603
そのコード読むのが自分だけか複数人かでメンテしだいじゃ無いの

**デフォルトの名無しさん** · 2020/06/08(月) 01:11:56.88

>>596
確認した

変数で受ける以前の問題だな
DirとかいまだにUnicode対応されてないのか
だったら8.3形式で返せばいいのにな

**デフォルトの名無しさん** · 2020/06/08(月) 07:02:43.86

>>606
ググるとFileSystemObject使えって書いてあるな

**582** · 2020/06/08(月) 07:46:04.95

>>607
でも、変数で受けちまうと何使っても?になっちまうよ。
それにFileSystemObjectのファイル列挙は糞遅かった筈。
特別な理由が無いならエラーで抜けちまって、特殊なファイル名には非対応とメッセージ出した方が良い気がする。

**582** · 2020/06/08(月) 08:00:05.61

>>601
少し住所を扱う処理を動かせば直ぐに気付くレベルの話だよ。
特にスペースなんて人名や住所以外でもよくある話。
全角だろうが半角だろうが""に変換しちまうのはよくやるだろう。
まあ、全角半角は数字とかアルファベットでも問題になるからその前にStrConv使って統一するとかが普通の処理だろう。
ハイフンだって思いつくものはマイナスに変換する程度のことはする。

**デフォルトの名無しさん** · 2020/06/08(月) 08:12:22.59

むしろテキストボックスのEN_UPDATEでスペースやハイフンを消せば楽
郵便番号欄は数字以外受け付けないようにスタイル指定するだけでもいい

**デフォルトの名無しさん** · 2020/06/08(月) 08:46:24.73

フォルダを指定し、そのフォルダ内の全てのブックの、各ブックのシート"sire"の２行目から最終行をコピーして
シートcompの最下行の一つ下に張り付けていき、Ｉ列に各ブック名を記入していくマクロを教えてください。

Sub comp()

'フォルダを選択
Dim path As String
Dim r As Long
Dim buf As String
Dim i As Long
Dim filename As String
Dim mysheet As Worksheet
Dim srcbook As Workbook
Dim srcsheet As Worksheet

With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then
MsgBox "キャンセルされました。"
Exit Sub
End If
path = .SelectedItems(1)
End With

Application.ScreenUpdating = False

**デフォルトの名無しさん** · 2020/06/08(月) 08:47:00.39

続き

Range("A1").Value = "担当者"
Range("B1").Value = "行程１"
Range("C1").Value = "件名１"
Range("D1").Value = "行程２"
Range("E1").Value = "件名２"
Range("F1").Value = "行程３"
Range("G1").Value = "件名３"
Range("H1").Value = "期間"
Range("I1").Value = "グループ名"

Set mysheet = ThisWorkbook.Worksheets("comp")
Debug.Print myseet

buf = Dir(path & "\*.xls") 'フォルダ内の全ファイル名

Debug.Print buf

Do While buf <> ""

Set srcbook = Workbooks.Open(path & "\" & buf)

Set srcsheet = srcbook.Worksheets("sire")

**デフォルトの名無しさん** · 2020/06/08(月) 08:47:32.50

続き
filename = 'srcsheetの拡張子なしのファイル名を取得

'シートの内容を２行目以降コピー
srcsheet.Range(Cells(2, 8), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 8)).Copy

'myseetの最下行の一つ下に値として貼り付け
mysheet.Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues

'I列にそれぞれのファイル名を入力
For r = Cells(Rows.Count, 9).End(xlUp).Row + 1 To Cells(Rows.Count, 1).End(xlUp).Row
Range("I" & r).Value = filename
Next r

srcbook.Close False

buf = Dir()

Loop

Cells.EntireColumn.AutoFit

Application.ScreenUpdating = True

End Sub

**デフォルトの名無しさん** · 2020/06/08(月) 10:43:42.37

ワークシートの指定について

Activesheetだと動いて、worksheets(index)やworksheets("シート名")にするとプログラムが動かないことが多いのですが、何故でしょうか

下のようなプログラムを作りました。（Sheet2のA列の数字でSheet1にフィルターをかけて、pdf出力を繰り返す）

Sub Macro3()
For Each c In Worksheets("Sheet2").Range("A1:A68")
i = c.Value
a=1
Worksheets(1).Range("$B$4:$N$6492").AutoFilter Field:=1, Criteria1:=i
Worksheets(1).PageSetup.RightHeader = "　　　" & i
r = Range("$B$5:$B$6492").Find(i).Row
Worksheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Documents" & i & "." & Cells(r, 11).Value
Next c
End Sub

これを実行しても、フィルターがかからず、pdf出力メソッドの部分でエラーが起きます。
しかし、Worksheets(1)　を Activesheetに直して、Sheet1をアクティブにした状態で動かすと正常に動きます。
イミディエイトウィンドウでWorksheets(1)が正しく指定されているかも確認しましたが、されていました。
一体何が原因なのでしょうか。

**デフォルトの名無しさん** · 2020/06/08(月) 11:07:13.39

>>614
入力ミスがないとして、この2箇所でシートの指定が抜けてるのが原因では
Range("$B$5:$B$6492").Find(i).Row
Cells(r, 11).Value

何度もWorksheets(1)を書くんじゃなくて、Forの外でActivateするかWithでSheet1を指定した方が間違いがなくていいと思う

**デフォルトの名無しさん** · 2020/06/08(月) 11:07:50.22

workbookは指定してるの？

**デフォルトの名無しさん** · 2020/06/08(月) 14:34:55.82

アドインに記述されてるプロシージャを、シート上の図形をボタンにしてそこから走らせたいのですが、
引数を渡そうとすると、このブックでマクロが使用できないかすべてのマクロが無効なっている可能性があります、と出て実行できません
すべてのマクロを有効にしてもダメでした
引数なしの場合は、マクロが無効であっても、なんの問題もなく実行されます
登録は、'プロシージャ名 "引数"'とやっているのですが、マクロからそのままやると実行されますが、ボタンに登録すると実行されません
なにが問題なんでしょうか？

**デフォルトの名無しさん** · 2020/06/08(月) 15:14:19.45

sub 引数なし()
引数あり "引数"
end sub

**デフォルトの名無しさん** · 2020/06/08(月) 15:39:02.50

なるほど・・・
結構な数のボタンになるので面倒ですが、ひとまずそれでやってみます

**デフォルトの名無しさん** · 2020/06/08(月) 15:41:22.39

プルダウンなりなんなりで選ぶなりなんなりさせればいいじゃないなり

**デフォルトの名無しさん** · 2020/06/08(月) 16:55:09.51

イベント付きボタンのクラス作ればいいんじゃないのかな

**611** · 2020/06/08(月) 17:50:20.70

srcsheet.Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 8)).Copy

のところが違うみたいです。どう書けばいいですか？

**デフォルトの名無しさん** · 2020/06/08(月) 18:10:47.25

シート名が抜けるの俺もむかーしよくやったわぁ
アクティブにすると直るんだよなぁｗ
何度やったか記憶にないぐらいやって痛い思いした

**デフォルトの名無しさん** · 2020/06/08(月) 18:31:02.99

withで囲んでもドットを忘れてそれに気づかずいつまでもソースとにらめっこしたりな

**デフォルトの名無しさん** · 2020/06/08(月) 18:52:12.93

>>622
srcsheet.Range(srcsheet.Cells(2, 1), srcsheet.Cells(Cells(Rows.Count, 1).End(xlUp).Row, 8)).Copy
確証ないけど…

**デフォルトの名無しさん** · 2020/06/08(月) 19:01:25.33

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Sh.Range("A:Z").Interior.Color = xlNone
If Intersect(Sh.Range("A:Z"), Target) Is Nothing Then
Exit Sub
Else '赤く色が変わる列
Intersect(Selection.EntireRow, Sh.Range("G:Z")).Interior.Color = RGB(0, 255, 0)
End If
End Sub

とにかく複数選択したセル行の特定の列を全部色付け
選択をやめると色が戻る(デフォルト)をやりたくて
ThisWorkBookにこれを追記
で、なんとか希望の動きになったんですが
これに1行目から7行目は除外(選択しても色が付かない)
という条件の追加は可能ですか？
自分の知識じゃ無理ゲーですみません

**デフォルトの名無しさん** · 2020/06/08(月) 19:48:40.38

>>626
一番最初に、ifステートメント入れれば良い。
if target.row >=8 thenとか。

**611** · 2020/06/08(月) 20:15:16.49

>>622
ありがとうございますm(__)m

**デフォルトの名無しさん** · 2020/06/08(月) 20:24:46.83

>>627
おおお、ありがとう理想の挙動に近づきました！
これだと12行目を選択した後にやめて
1行目を選択しても12行目の色が残っちゃうんだけどそれは回避不能ですか？

If Intersect(Sh.Range("A:Z"), Target) Isのところを
If Intersect(Sh.Range("A8:Z5000"), Target) Is
とかに変えても少し挙動が近づいた気もしますが、

**デフォルトの名無しさん** · 2020/06/08(月) 20:28:42.90

構造体のメンバ変数を頭からindexで指定するようなことってできませんか？
for文で構造体のメンバ変数と配列とを順次比較したいんですが。

**デフォルトの名無しさん** · 2020/06/08(月) 20:28:54.07

変数名やプロシージャ名を日本語で書くか否か迷ってます
日本語命名で困ったことが起こった人はいますか

**デフォルトの名無しさん** · 2020/06/08(月) 20:30:33.47

>>629
少しは頭を使えよ、馬鹿

**デフォルトの名無しさん** · 2020/06/09(火) 00:06:52.26

>>632
頭使ったらハゲるだろ、このハゲ

**デフォルトの名無しさん** · 2020/06/09(火) 00:40:35.48

ちょっとトンチンカンかもしれないですが
WindowsのエクセルのVBAって
LinuxのOpen OfficeのCalcでも使えたりするんでしょうか？

**デフォルトの名無しさん** · 2020/06/09(火) 01:33:20.60

>>631
あるぞ
英語環境しかないPCだと使えなくなる
人に送ったら面倒になった

**デフォルトの名無しさん** · 2020/06/09(火) 03:31:53.35

>>631
うちが英語とスペイン語環境しかなくて送られてきたVBAが動かなくて困った事が何度もある
日本人だからって日本語環境でやってるわけではない

**デフォルトの名無しさん** · 2020/06/09(火) 03:41:28.59

>>634
ExcelVBAはWinとMacでも違いがある
Win/Mac/Linuxで使えるOOoやLOのCalcで使えるVBAは制限やできない事があるけど一応使える

**582** · 2020/06/09(火) 08:27:55.73

>>631
日本人にとってもコードが読みにくくてかなわん。

**デフォルトの名無しさん** · 2020/06/09(火) 09:00:21.92

>>631
会社で使うなら社内の自分より詳しい人に相談してみ

**デフォルトの名無しさん** · 2020/06/09(火) 09:06:51.24

個人的には日本語プロシジャー名好き
処理名だと分かりやすい

**デフォルトの名無しさん** · 2020/06/09(火) 09:38:40.07

困った時のローマ字
Sub CSV_no_deTa_wo_rodo_suru()

**デフォルトの名無しさん** · 2020/06/09(火) 09:49:38.68

そもそもシート名で日本語使ってるからね
気にするならそこからやらないとね

**デフォルトの名無しさん** · 2020/06/09(火) 09:56:55.81

>>631
単純に一つの言語で統一した方が読みやすい
これは一般的な文章でも感じられると思う
逆にコメント等を日本語にすることで注釈として意識させることが出来る
自分は実装には使わないテスト用のメソッドをを日本語名にする事はあるよ

アメリカに送ったら云々は条件が特殊だし、
日本語コメントも文字化けするんだから関係ないだろと思う

**デフォルトの名無しさん** · 2020/06/09(火) 10:05:30.26

システムとして表示やコンパイルが可能かってのと、それを読む人間が外国語を理解できるかはまた別の話
とりまファイル名やワークシートに入ってるデータが日本語なら何も気にしなくていいってことよ
そもそも半角文字だって国によって割り当てが違うんだし

**デフォルトの名無しさん** · 2020/06/09(火) 10:25:08.00

いずれにしても海外環境で動くかって話になると、
関数名ひとつの話じゃないってことだな

**デフォルトの名無しさん** · 2020/06/09(火) 11:06:11.34

>>640
自分はプロシージャ名だけでなく変数名にもときどき使ってます。
変数名を横文字で考え付くのが面倒ってこともありますが。
行や列の位置を示す変数に　tate yoko の後は　行　列　縦　横　など。

**デフォルトの名無しさん** · 2020/06/09(火) 12:07:12.66

賛否両論(少し否優勢)な感じね

賛の中でもプロシージャ名、関数名、定数変数名のどこまで日本語が許されるかも派閥次第か

**582** · 2020/06/09(火) 12:11:23.51

iとかなら良いけど変数の型とかプロシージャなのか区別出来る名前になってないと最悪。
で、日本語の名前つけてるのにそんなのが多い。

**デフォルトの名無しさん** · 2020/06/09(火) 12:33:34.60

>>637
ありがとうございます

**デフォルトの名無しさん** · 2020/06/09(火) 12:34:58.09

変な事せずに命名規則に従った方がいいと思うけどね
メシマズ嫁と同じ思考回路だぞ

**デフォルトの名無しさん** · 2020/06/09(火) 14:16:42.79

すみません。どなたか詳しい方、ご指導願います。
データ計算をVBA作成しようとして悩んでいます。

リストボックスにある地名を選択して、テキストボックス1に数字を
入力したらテキストボックス2に対応した数値を出したいのですが
上手く書けません。

データシートのA列(A2からA300)には地名、横軸(B1からBG1)には整数値(50ずつの数値)があり
地名と整数値の交点には、それぞれ対応した金額が入っています。
またリストボックスの地名は「地名」として別シートを作成しています。

説明方法が悪くて申し訳ないのですが記述の方法の
解説を宜しくお願いします。

**デフォルトの名無しさん** · 2020/06/09(火) 14:31:54.35

h,vlookupじゃダメなんですか？

**デフォルトの名無しさん** · 2020/06/09(火) 14:36:44.80

どこまで書けてて、どこから分からないの？

**デフォルトの名無しさん** · 2020/06/09(火) 14:38:50.34

XY座標のセル表示して終わりじゃないなら
ピボット勉強した方が良いと思う

**デフォルトの名無しさん** · 2020/06/09(火) 14:49:37.66

651です。

Private Sub ListBox1_Change()
ListBox3.Clear
Select Case ListBox1.Text
Case "東京都"
ListBox3.List = Worksheets("データ").Range("A2:A8").Value
(略)
End Select
With ListBox3
.ColumnHeads = False
.ColumnCount = 1
.ColumnWidths = "40;50;50"
.Font.Name = "Meiryo UI"
.Font.Size = 11
End With
End Sub
Private Sub TextBox2_AfterUpdate()
Dim TextBox2 As Range
Dim TextBox3 As Range
Set TextBox2 = Worksheets("データ").Range("A2:A13")
Set TextBox3 = TextBox2.Find(What:=TextBox2.Value, LookAt:=xlPart)
If Not TextBox3 Is Nothing Then
'ヒットした値をテキストボックスにセット
TextRegion.Value = Worksheets("データ").Cells(TextBox3.Row, TextBox3.Column + 8).Value

End If

End Sub
なんか変です。。。

**デフォルトの名無しさん** · 2020/06/09(火) 14:54:09.61

651です。
たぶんツッコミどころ満載です。
交点のセレクトできていません。

**デフォルトの名無しさん** · 2020/06/09(火) 15:51:31.81

なぜ段階を踏んで自分でテストモデルを組んでみないのかが疑問だわ
初心者の頃も含めてその程度の内容で誰かに聞いたことすらないわ

**デフォルトの名無しさん** · 2020/06/09(火) 15:53:54.04

１．リストボックスで選択してボタン押して他のフォームで項目表示できるか
２．テキストボックスに書き込んでボタン押して他のフォームのテキストボックスに表示できるか
３．リストボックスとテキストボックスで選択と書込をして同じフォーム上のテキストボックスに対応した数字を出せるのか

とかとか

**デフォルトの名無しさん** · 2020/06/09(火) 16:19:22.27

マクロの記録使うのはいいけど
その結果の意味ぐらい調べようよ
ググらなくてもF1キー押せば表示されるからさ

**デフォルトの名無しさん** · 2020/06/09(火) 16:24:07.60

>>655
下の関数内で使ってる変数名を具体的に書いてみたらどうかな
TextRangeForSearchTargetみたいな文章風でもいいから

**デフォルトの名無しさん** · 2020/06/09(火) 17:05:07.59

ユーザーフォームに
https://www.s-projects.net/degree-position.html
のサイトにあるような
位置度の算出を丸々搭載したいけど
素人にゃ厳しいですかね？

**デフォルトの名無しさん** · 2020/06/09(火) 17:28:45.58

>>661
簡単

**デフォルトの名無しさん** · 2020/06/09(火) 17:40:53.94

ユーザーフォーム使ってTextBox1とTextBox2に数字いれてTextBox3に足し算の結果だすような基本をまず調べればあとは適当にぐぐりゃ分かるわな

計算途中も変数いちいち宣言して代入していくといいわ
自分で何やってんのか見失わないようにするため

Sub testttt()
Dim drawingX As Double: drawingX = 2
Dim drawingY As Double: drawingY = 2

Dim realX As Double: realX = 2.1
Dim realY As Double: realY = 2.1

Dim diffX As Double: diffX = realX - drawingX
Dim diffY As Double: diffY = realY - drawingY

Dim ResultPosition As Double: ResultPosition = Sqr(diffX * diffX + diffY * diffY) * 2

MsgBox ResultPosition

End Sub

**デフォルトの名無しさん** · 2020/06/09(火) 17:54:43.46

Private Sub TextBox1_Change() 'Xの図面寸法
TextBox3 = Val(TextBox1.Value) - Val(TextBox2.Value)
End Sub
Private Sub TextBox2_Change() 'Xの測定値
TextBox3 = Val(TextBox1.Value) - Val(TextBox2.Value)
End Sub
Private Sub TextBox3_AfterUpdate()'Xのズレ
TextBox3 = Val(TextBox1.Value) - Val(TextBox2.Value)
End Sub
Private Sub TextBox4_Change()'Yの図面寸法
TextBox6 = Val(TextBox4.Value) - Val(TextBox5.Value)
End Sub
Private Sub TextBox5_Change() 'Yの測定値
TextBox6 = Val(TextBox4.Value) - Val(TextBox5.Value)
End Sub
Private Sub TextBox6_Change() 'Yのズレ
TextBox6 = Val(TextBox4.Value) - Val(TextBox5.Value)
End Sub
Private Sub TextBox7_Change()
'位置度最難関
TextBox7 = Val(Sqr(TextBox3.Value) ^ 2) + Val(Sqr(TextBox6.Value) ^ 2) * 2
End Sub
tBox6.Value) ^ 2) * 2
End Sub
1～6まではぐぐったらなんとかできた
あとは7…　>>663　ぐぐるより難しそうで無理す

**デフォルトの名無しさん** · 2020/06/09(火) 17:58:28.74

ああ、最後に変なコピペが混じってる
3と6にも多分式を入れないとだめですよね恐らく

**デフォルトの名無しさん** · 2020/06/09(火) 18:02:48.17

いや違う、むしろ7に入れずに3と6っぽい？
そもそもド素人にはやはり厳しいね
頑張りますわ

**デフォルトの名無しさん** · 2020/06/09(火) 18:44:30.51

うおぉ、浮動小数点かこりゃ？
どっかでroundで四捨五入せんといかんのね
１人であたふたすまん
ほんとムズい

**デフォルトの名無しさん** · 2020/06/09(火) 19:24:04.57

Changeイベントなんか使うから難しくなるわけで・・・・

そのサイトにあるように、ボタン押して計算するようなもの作りたいんだろ？

ならズレ角度抜きで、テキストボックス7個作って
ボタン押すと上の4個から数値拾ってきて下の3個に計算結果を入れるっていうな

イベント系はCommandButton1_Click()だけでいいはずだぞ

**デフォルトの名無しさん** · 2020/06/09(火) 19:44:15.62

Private Sub CommandButton1_Click()
Dim drawingX As Double: drawingX = TextBox1.Value
Dim drawingY As Double: drawingY = TextBox2.Value

Dim realX As Double: realX = TextBox3.Value
Dim realY As Double: realY = TextBox4.Value

Dim diffX As Double: diffX = realX - drawingX
Dim diffY As Double: diffY = realY - drawingY

Dim ResultPosition As Double: ResultPosition = Sqr(diffX * diffX + diffY * diffY) * 2

TextBox5 = ResultPosition
End Sub

https://i.imgur.com/yhMCwtL.jpg
位置度だけだけど。
テキストボックスはIMEModeOffにしておく

**デフォルトの名無しさん** · 2020/06/09(火) 19:49:22.56

なんでユーザーフォームってクソダサなんだろな
色変えられるんだしMicrosoftももうちょい気遣ってくれてもいいのにな

**デフォルトの名無しさん** · 2020/06/09(火) 20:04:52.19

>>669
天才ですか、、
何も知らん癖に自動にしたいかなぁと
思って検索してパクりまくって作ってましたわ
ズレ量も欲しいからとせっせと
小数点も3桁以上は四捨五入したく
1～4までは意味も分からずとりあえず
ちゃんと挙動してるかなぁレベル
アドバイス貰う以前の素人レベルだからスクショですんません
原理すらわかってない
https://i.imgur.com/0iPDqgX.jpg
https://i.imgur.com/ksEqFVN.jpg

**582** · 2020/06/09(火) 20:10:52.53

>>664
そういう書き方せずに>>663を具体的な値の部分は削除してまず関数化する。

Function GetResultPosition(drawingX As Double, drawingY As Double, realX As Double, realY As Double) As Double

Dim diffX As Double: diffX = realX - drawingX
Dim diffY As Double: diffY = realY - drawingY

Dim ResultPosition As Double: ResultPosition = Sqr(diffX * diffX + diffY * diffY) * 2

GetResultPosition = ResultPosition

End Function

初心者を脱っしていれば、点はユーザー定義にしてると思うけど、まあこんな感じ。

**デフォルトの名無しさん** · 2020/06/09(火) 20:19:17.07

いつまで素人素人言い訳してくれくれする気だ

**582** · 2020/06/09(火) 20:19:48.80

次にTextBoxの値を関数い代入する。
なお、TextBoxの名前もそれっぽく変えておく。
Sub test()
Dim drawingX As Double
Dim drawingY As Double
Dim realX As Double
Dim realY As Double

drawingX=txtDrawingX.Value
drawingY=txtDrawingY.Value
realX=txtRealX.Value
realY=txtRealY.Value

txtResult.Value=GetResultPosition(drawingX, drawingY, realX, realY)

End Sub

**デフォルトの名無しさん** · 2020/06/09(火) 20:28:43.03

ごめんスクショの所も直しきれてなかったし初心者を脱してないレベルだから
調子乗って挑戦しようと思ったのが間違い

測定値はどこまで小数点書こうが3桁で四捨五入
ズレ量も四捨五入された3桁で表示
四捨五入された3桁のズレ量同士で計算されて
位置度も3桁で四捨五入されてフィニッシュ

やろうとした事が多すぎました
普段のエクセルのSQRT関数入れたツールか
関数電卓で断念します
クレクレとかじゃなく、助言みんなありがとうです

**582** · 2020/06/09(火) 20:51:16.65

>>675
四捨五入なんて最後で良いじゃん。
ResultPositionを四捨五入して返すだけだと思うが。
入力の見た目も四捨五入したいならそれぞれでやりゃ良いし。
どっちにしろ、四捨五入なんて考えずに作って、出来てから考えた方が良いぞ。

**デフォルトの名無しさん** · 2020/06/09(火) 21:14:50.07

>>676
どうも…事情がありまして
ズレ量と位置度を両方記入する必要があるから計算を合わせたいのです
そうしないと記入したズレ量と数値の計算が違ってくるので
なので普段はExcel関数ツール作ってで計算させてます

(名称はセル番地)
まず小数点7桁ぐらいで出力されてきやがるズレ量をRound関数で全て小数点3桁にする
↓
小数点3桁同士で位置度の計算をさせる
=if(位置度="","",SQRT(SUMSQ(X実測値-X図面寸法,Y実測値-Y図面寸法))*2)
↓
最後に出た位置度も小数点3桁にする
=if(位置度="","",Round(位置度,3)
↓
位置度とズレ量を小数点3桁まで記入
現状これが自分の最善だったので…

**デフォルトの名無しさん** · 2020/06/09(火) 21:21:13.62

間違えた
小数点3桁同士で位置度の計算をさせる
=if(Xの実測値="","",SQRT(SUMSQ(X実測値-X図面寸法,Y実測値-Y図面寸法))*2)

2つ目はこうやった

**582** · 2020/06/09(火) 21:24:41.76

>>677
いやいや、そういう話じゃなくてね、そんなもんは最後に入れれば良いでしょ。

先ずは四捨五入無しで動くところから。
あとTextBoxとかイベントとかも後でいいんだよ。

**デフォルトの名無しさん** · 2020/06/09(火) 21:29:48.33

>>679
ごめん、ほんと初心者以前知識すらない関数だけで凌いできたレベルでちょいネットで調べりゃ出きるかなと思ったらもう手つけられんのですわ
クレクレ以前の問題で
それでも
>>669のは頂こうと思うとります

**デフォルトの名無しさん** · 2020/06/09(火) 21:37:07.98

そういう業務と無縁だからエクセル関数で計算とかほとんど知らん俺からすると
そんな数式ほんとかよと思ったら
ほんとだった
それはそれでよく考えたもんだなおい
測定をする？部署は凄いね

**デフォルトの名無しさん** · 2020/06/09(火) 21:38:09.42

>>680
悪いことは言わんから早いうちに転職しなされ
こういう仕事向いてないよ

**デフォルトの名無しさん** · 2020/06/09(火) 21:41:34.61

プログラミングの基本も知らないレベルの人がコピペでツール作って業務に使用するって大丈夫なのか？

**デフォルトの名無しさん** · 2020/06/09(火) 21:45:05.79

少数以下の計算結果を同じにするのは、Excelでは一番難しい分野の一つ
たとえば銀行の利息とか、素人が作った数式だとまず合わない

**デフォルトの名無しさん** · 2020/06/09(火) 21:56:09.99

この先も苦労するだろうし、もし重大な問題が起きた場合周りが迷惑するんだよな

**デフォルトの名無しさん** · 2020/06/09(火) 21:59:00.39

馬鹿に教えても何かあるとまた頼るだけ
馬鹿に教えてもろくなことにならんぞ
その場で形だけ低姿勢にしてるだけで本音は違うからな

**デフォルトの名無しさん** · 2020/06/09(火) 22:01:59.19

より正確な計算するのってcurrency型だっけ？
double使うより

**デフォルトの名無しさん** · 2020/06/09(火) 22:10:25.08

向き不向き以前に学習する気が無い

**デフォルトの名無しさん** · 2020/06/09(火) 22:26:28.10

少数の計算はどの言語でやってもやっかい
なので普通は名の知れたライブラリを呼ぶ
自分で書くのは最後の手段

**デフォルトの名無しさん** · 2020/06/09(火) 22:27:34.95

>>687
違いがわからない馬鹿はコメントしなければ良いのに

**デフォルトの名無しさん** · 2020/06/09(火) 23:36:40.87

スレチかもしれないけど他の方法も・・
>>651
VBA使わずにフォームコントロールのリスト選ぶだけで表示
https://i.imgur.com/SHqygJ1.png

>>661
HTAのVBSciptで
https://i.imgur.com/rvwycaA.png