- ベストアンサー
回転移動も加味した平行移動のコード修正と数値非表示
- 質問No.2876302で質問された項目に関連して、回転移動だけでなく平行移動を加味するためのコード修正を依頼しています。
- コード修正後、エラーが発生したため、表示される意味不明な数値を非表示にする方法についても質問しています。
- 質問No.2876302と同じく、平行移動量が可変量のため、導入データ群を読み込んでおきます。
- catshoes01
- お礼率71% (148/206)
- 数学・算数
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- 配列を利用したコードにしてください
下記コードですが 計算速度が遅いので配列を利用した コードに修正してください。お願いいたします。 Dim mx As long Dim Rp As Double Dim yy1 As Double Dim pai As Double Dim Ba AS long Dim i As long, j as long Dim K As Doubke Dim xx1 As Double, yy1 As Double Dim x0 As Double,y0 As Double Dim x1 As Double, y1 As Double mx = Sheets("nn").Range("B65536").End(xlUp).Row Rp1= Sheets("pp").Range("B65536").End(xlUp).Row yy1= Sheets("pp").Range("A25") With Sheets("zzz") pai=Atn(1) * 4 Ba=Sheets("sheet1").Range("A1") For I = 1 To Ba K = -Sheets("sheet1").Range("B" & I + 3).Value * pai/180 xx1 = Sheets("sheet1").Range("C" & I + 3).Value yy1 = Sheets("sheet1").Range("D" & I + 3).Value For j = 1 To mx - 1 x0 = .Cells(2 + j, 2) y0 = .Cells(2 + j, 3) X1 = x0 * Cos(K) + y0 * Sin(K) Y1 = -x0 * Sin(K) + y0 * Cos(K) .Cells(2 + j, 2 * I + 2) = X1 + xx1 - Rp1 .Cells(2 + j, 2 * I + 3) = Y1 + yy1 Next j Next I End with
- 締切済み
- オフィス系ソフト
- エクセルVBA カウンタ2つを入れ子にしたくない時
皆さんこんにちは。 エクセル2013を使用しております。 エクセルVBAの繰り返し処理について質問させていただきます。 下記のコードですと入れ子があるので A1にi、A3にi・・・・を一通り記載したあと またA1にi+2、A3にi+2・・・を繰り返し 最終的にA列には全て同じ値が入ってしまいます。 （Step 2にしたのはA1:A2のように2行毎の結合セルだからです） ----------------------------------------------------------------- Dim i As Long Dim j As long Dim n As long Dim k As long i ＝Userform.textbox1.value j =Userform.textbox2.value For k =i To j Step 2 For n = 1 to j Step 2 Range("A" & n) = k Range（”B”＆ｎ)＝ｋ+1 Next Next ---------------------------------------------------------- もしiが1、jが10だとしたら A1に1、B1に2、A3に3、B3に4、・・・A9に9、B9に10 が入るようにするにはどうしたら良いでしょうか。 iが必ず1から始まるのであればまだ分かるのですが そうとも限らないので カウンタはやはり2つ必要だと思うのですが カウンタが2つあるのに入れ子にしないコードの書き方って あるのでしょうか。 いくら本やネットを見ても分かりません。 ご教授いただけると幸いです。
- ベストアンサー
- Excel（エクセル）
- エクセルマクロで変数を使ったセル範囲指定
Dim x As Long Dim y As Long として x = Range("A1").End(xlDown).Row For y = 1 To x としました。 このときRange("A" & y)からRange("A" & x)を範囲指定したいときは どのように記述すればよいのでしょうか？
- ベストアンサー
- オフィス系ソフト
- ExcelのVBAの配列に関する質問です。
ExcelのVBAの配列に関する質問です。 sheet1のデータをsheet2に表示するVBAを作成しています。。 sheet1のデータは7行目からスタートし、sheet2のデータは26行目からスタートしています。。 sheet1とsheet2の列は同じ並びではないため、それぞれのシートの列番号をCellsを用いて指定しています。 Sub test1() Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 Worksheets("sheet2").Cells(j, 1) = Worksheets("sheet1").Cells(i, 2) Worksheets("sheet2").Cells(j, 8) = Worksheets("sheet1").Cells(i, 28) Worksheets("sheet2").Cells(j, 9) = Worksheets("sheet1").Cells(i, 31) Worksheets("sheet2").Cells(j, 10) = Worksheets("sheet1").Cells(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub 上記のtest1は正常に動くのですが、データ量が多いため、処理に時間がかかってしまいます。 高速化できないかと、以下のように変更しました。 Sub test2() Dim dataRange1 As Variant Dim dataRange2 As Variant dataRange1 = Worksheets("sheet1").Range("A1:GI10006") dataRange2 = Worksheets("sheet2").Range("A1:DZ10018") Dim endrow As Long endrow = Worksheets("sheet1").Range("A65536").End(xlUp).Row Dim i As Long Dim j As Long For i = 7 To endrow j = i + 19 dataRange2(j, 1) = dataRange1(i, 2) dataRange2(j, 8) = dataRange1(i, 28) dataRange2(j, 9) = dataRange1(i, 31) dataRange2(j, 10) = dataRange1(i, 32) ・ ・ ・ ※長いので省略 Next i End Sub test2は、エラーメッセージ等は表示されませんが、sheet2にデータが表示されません。 ちなみに、以下のようにsheet1のみ配列化した場合は、正常に表示されました。 Worksheets("sheet2").Cells(j, 1) = dataRange1(i, 2) Worksheets("sheet2").Cells(j, 8) = dataRange1(i, 28) Worksheets("sheet2").Cells(j, 9) = dataRange1(i, 31) Worksheets("sheet2").Cells(j, 10) = dataRange1(i, 32) test2は、どこが間違っているのでしょうか？ ご教示ください。 よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- ExcelのＶＢＡで質問です。
以下のようなシートがあります。 A列 Ｂ列 Ｃ列 Ｄ列 Ｅ列 Ｆ列 Ｇ列 Ｈ列 ＮＯ 名前 確認 日付1 日付2 確認 日付1 日付2 6行目からデータを入れる予定です。 Ｃ列には○印を入力します。 Ｃ列～Ｅ列までデータが入った行は、 Ｆ列～Ｈ列まで同じ処理をします。 （セルの背景色を変えます。） 以後同じことを列方向で繰り返します。 以下のようなＶＢＡを組みましたが、 ○の個数を数える部分でエラーがでます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim staff As String Dim kakunin As String Dim date1 As Date Dim date2 As Date Dim i As Long Dim j As Long Dim cnt As Long '100件分ループ For i = 6 To 105 '○の数をカウント cnt = WorksheetFunction.CountIf(ActiveSheet.Range(Cells(i, 2), Cells(i, 256)), "○") 'jとは確認の列番号のこと j = 3 * cnt staff = Cells(i, 2) kakunin = Cells(i, j) date1 = Cells(i, j + 1) date2 = Cells(i, j + 2) 'スタッフ名が入力されたら If staff = "" Then Range(Cells(i, j), Cells(i, j + 50)).Interior.ColorIndex = 15 Else Cells(i, j).Interior.ColorIndex = xlNone '○が入力されたら If kakunin = "○" Then Range(Cells(i, j + 1), Cells(i, j + 2)).Interior.ColorIndex = xlNone Else Range(Cells(i, j + 1), Cells(i, j + 2)).Interior.ColorIndex = 15 End If If Cells(i, j + 1) <> "" And Cells(i, j + 2) <> "" Then Cells(i, j + 3).Interior.ColorIndex = xlNone End If End If Next i End Sub ご教授いただけたら、幸いです。 よろしくお願いいたします。
- ベストアンサー
- その他MS Office製品
- エクセル マクロ 繰り返し処理の制御方法について
お世話になります。エクセル初心者です。 登録用のシートから（データ数は、5000行ほど）、印刷用のシートへの転記を考えています。 下記のコードはテスト用の簡易なものですが、試行錯誤でここまではたどりついたのですが。 A列には大分類用の番号を入れてあるので、A列のセルの値が変わるまで、同じ処理を繰り返したいのですが、そのためにはどうしたらよいでしょうか。下記のコードの i と j の変数部分を連動させたい（A列の同じ値の数だけ、５行おきの転記をしたい）のですが。 Do until 構文も試してみたのですが（下記のコードでは、テストなので、「=2」のように固定にして（a)の部分に挿入してみました。）、エラーメッセージに従い、Loop の位置を(b)から(c)に変えてみたところ、無限ループに陥り、対処に困っています。 よろしくお願いします。 Sub test3() Dim i As Long Dim j As Long i = 1 '転記元の行 'Do until range("A"&i)=2 -----------------------(a) For j = 1 To 200 Step 5 '転記先の行 Range("J" & j) = Range("B" & i) Range("k" & j) = Range("C" & i) Range("L" & j) = Range("D" & i) Range("J" & j + 1) = Range("E" & i) Range("J" & j + 2) = Range("F" & i) Range("J" & j + 3) = Range("G" & i) i = i + 1 'Loop-------------------------------------------'(b) Next j 'Loop-------------------------------------------'(c) End Sub
- ベストアンサー
- その他MS Office製品
- 他のシートの任意の列に１行おきに表示する
よろしくお願いします。 下の構文ですと Worksheets("入力")の３列目５行目以降のデーターが Sheet2の同じ列（３列目）５行目以降に１行おきに表示されます。 これを Worksheets("入力")の３列目５行目以降のデーターを Sheet2の７列目５行目以降に１行おきに表示したいのですが どのように書き直せばよいでしょうか。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i As Long, j As Long j = 5 With Worksheets("入力") For i = 5 To .Cells(Rows.Count, 3).End(xlUp).Row .Rows(i).Copy Worksheets("Sheet2").Cells(j, 1) j = j + 2 Next i End With End Sub
- ベストアンサー
- その他（プログラミング・開発）
- msgboxの表示
Ａ列の値とC列の値をMsgboxに表示するにはどうしたらいいのでしょうか？C列で一番高い商品とその品名A列を表示させたいのですが・・ Sub hinmei() Dim i As Long For i = 2 To Range("C65535").End(xlUp).Row Dim x As Long Dim a As Long x = Cells(i + 1, 5) If Cells(i, 5).Value < x Then a = x End If Next MsgBox a End Sub
- 締切済み
- Visual Basic
- Excel collectionについて VBA
Dim Mydata As New Collection Dim i As Long Dim EndNumber As Long On Error Resume Next 'データを登録する間、エラーを無視する For i = 2 To EndNumber '2行目から最終行までチェック Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 Next i On Error GoTo 0 i = 1 For Each A In Mydata Worksheets("Sheet1").Range("A" & i).Value = A i = i + 1 Next A 現在見ているシートの重複しない項目を 別シートに書き込みしているプログラムになります。 様々なサイトを参考にさせて頂き、 上記のような結果になり、 文字列は取得できるようになりました。 しかし、もとになるデータがある位置に（例は、J列） 数値が入っていると上手くコレクションに入ってくれません。 J列に文字列（りんご、ごりらなど）が入っている場合は 重複しない項目がコレクションに格納されていきます。 J列に文字列（0,1)が入っていた場合、 重複しない項目もなにも無く、 ローカルのMydataの中には<変数無し>とありました。 このプログラムの何処を直せば、数値をコレクションとして取得できますか？ ちなみに、EndNumberには最終行の数値が入っています。 ＞Mydata.Add Range("J" & i).Value, Range("J" & i).Value 'J列のデータ取得 .valueを.stringにしても効果はありませんでした。 回答よろしくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- Excel VBA TREND関数について
はじめまして、以前に教えて！gooに同じ質問が掲載されており、参考にさせて頂いたのですが 演算結果に違いが出てしまい原因がわかりません。どなたかアドバイスいただけませんか？ 私の環境 winXP sp3 office2000 ---------------------------------------------------------------------------------- 以前の回答(1) Sub Trend_Test() Dim y(10) As Double '既知のy Dim x(10) As Double '既知のx Dim newX As Double '新しいx '配列y()、x()に値を代入 y(1) = 100: x(1) = 1 y(2) = 200: x(2) = 2 y(3) = 300: x(3) = 3 y(4) = 400: x(4) = 4 y(5) = 500: x(5) = 5 y(6) = 600: x(6) = 6 y(7) = 700: x(7) = 7 y(8) = 800: x(8) = 8 y(9) = 900.1: x(9) = 9 '新しいx（例） newX = 5.5 '試しに計算結果を出力 Range("A1") = Application.Trend(y, x, newX, True) Range("A2") = Application.Trend(y, x, newX + 1, True) Range("A3") = Application.Trend(y, x, newX + 2, True) End Sub ---------------------------------------------------------------------------------- 以前の回答(2) Sub TEST_Trend() Dim x As Variant Dim y As Variant Dim NEWx As Double x = Array(0.005479452, 0.019178082, 0.038356164, 0.082191781, 0.167123288 _ , 0.252054795, 0.328767123, 0.41369863, 0.495890411, 0.580821918, 0.663013699 _ , 0.747945205, 0.832876712, 0.915068493, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 12, 15, 20) y = Array(0.055, 0.055, 0.057, 0.064, 0.086, 0.086, 0.087, 0.096 _ , 0.099, 0.1, 0.1, 0.1, 0.01, 0.103, 0.106, 0.15, 0.233 _ , 0.347, 0.483, 0.64, 0.817, 0.995, 1.163, 1.31, 1.545, 1.797, 2.07) NEWx = 0.05 Dim i As Integer For i = 1 To 20 Cells(i, 1) = Application.Trend(y, x, NEWx + i - 1, True) Next i End Sub ---------------------------------------------------------------------------------- 今回の検証 Dim y(6) As Double Dim x(6) As Double Dim newX As Double Dim YY As Variant Dim XX As Variant newX=7 y(1) = 92.87: x(1) = 1 y(2) = 92.55: x(2) = 2 y(3) = 91.64: x(3) = 3 y(4) = 92.3: x(4) = 4 y(5) = 93.29: x(5) = 5 y(6) = 92.59: x(6) = 6 Range("A1") = Application.trend(y, x, newX, True) Range("A1") には"119.085714285714"が出力されます XX = Array(1, 2, 3, 4, 5, 6) YY = Array(92.87, 92.55, 91.64, 92.3, 93.29, 92.59) または XX = Array(x(1), x(2), x(3), x(4), x(5), x(6)) YY = Array(y(1), y(2), y(3), y(4), y(5), y(6)) Range("B1") = Application.trend(YY, XX, newX, True) Range("B1") には"92.688"が出力されます ワークシート上でtrend関数を実行すると "92.688"を返しますので Arrayを使用した値と同じです ここで問題がありまして Do...Loop等でx(1)～x(6), y(1)～y(6)の値を取り出しています 取り出した配列（値は固定ではないのです）をどうのように Array(1, 2, 3, 4, 5, 6) または Array(x(1), x(2), x(3), x(4), x(5), x(6)) 等の形にしたら良いか分かりません たとえば Dim a as String Dim b as String a="1, 2, 3, 4, 5, 6" b = "92.87, 92.55, 91.64, 92.3, 93.29, 92.59" XX = Array(a) YY = Array(b) また、 Dim a As Variant Dim b As Variant a="1, 2, 3, 4, 5, 6" b = "92.87, 92.55, 91.64, 92.3, 93.29, 92.59" XX = Array(a) YY = Array(b) Range("D1") = Application.trend(YY, XX, newX, True) 演算結果は"#VALUE!"を返します どうのようにしたらよいのでしょうか？
- ベストアンサー
- オフィス系ソフト
お礼
平行移動は結局しないことになりました。お世話になりました。
補足
ありがとうございます。今ちょっと取り込んでいまして、 後程結果報告させていただきますね。