Excel VBA質問箱 IV

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

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


3668 / 13646 ツリー ←次へ | 前へ→

【60781】[無題] 新参者 09/3/14(土) 3:47 質問[未読]
【60782】Re:[無題] 横入り 09/3/14(土) 7:35 発言[未読]
【60807】Re:[無題] 新参者2 09/3/16(月) 14:42 発言[未読]
【60808】Re:[無題] kanabun 09/3/16(月) 16:36 発言[未読]
【60809】Re:[無題] 新参者3 09/3/16(月) 17:34 発言[未読]
【60811】Re:[無題] kanabun 09/3/16(月) 17:49 発言[未読]
【60813】Re:[無題] 新参者4 09/3/16(月) 18:04 発言[未読]
【60821】Re:[無題] 新参者5 09/3/17(火) 0:48 質問[未読]
【60825】Re:[無題] kanabun 09/3/17(火) 9:43 発言[未読]
【60829】Re:[無題] 新参者4 09/3/17(火) 13:47 お礼[未読]
【60830】Re:[無題] 新参者6 09/3/17(火) 14:08 発言[未読]
【60831】Re:全体の流れを確認しましょう kanabun 09/3/17(火) 14:24 発言[未読]
【60832】Re:全体の流れを確認しましょう kanabun 09/3/17(火) 15:00 発言[未読]
【60843】Re:全体の流れを確認しましょう 新参 09/3/17(火) 17:48 回答[未読]
【60844】Re:全体の流れを確認しましょう kanabun 09/3/17(火) 18:17 発言[未読]
【60810】Re:[無題] 新参者3 09/3/16(月) 17:39 発言[未読]

【60781】[無題]
質問  新参者  - 09/3/14(土) 3:47 -

引用なし
パスワード
   For文の中に更にFor文をいれ、ある列にその列の一つ左の列と更に左の列の演算式を作りました。
1度目(繰り返し回数)の列はうまくいくのですが、2度目の列は参照場所がおかしいです。

少し省略しておりますが、具体的に申し上げますと、
D列にC列/1000+B列という演算式を入れました。
65536行も還すようにしています。
またD列から右へ4列目も同じように演算式が入るようにしました。

しかしH列(D列から4列目)はG列、F列もみず、変な列を参照してしまいます。

理由が分かりませんので対処のしようがないです。

誰かお力をお貸し頂けないでしょうか。

よろしくお願い致します。

<省略>

'------------------------------あまり関係ない
u = 2
If u <= t * 4 Then

For w = u To 4 * t

 If sh1.Cells(3, u).Value = "" Then
  
   Exit For

sh1.Select
Cells.Clear
  
 End If

x = sh1.Cells(65536, u).End(xlUp).Row
sh2.Cells(18, 8).Value = x

If sh1.Cells(3, u).Value <> "" Then
sh1.Cells(2, u + 2).Value = "あ"
End If

For o = 3 To x

sh1.Cells(o, u + 2).FormulaR1C1 = "=RC[-1]/1000+RC[-2]" ← ここの構文


Next o

u = u + 4

Next w

【60782】Re:[無題]
発言  横入り  - 09/3/14(土) 7:35 -

引用なし
パスワード
   全角スペースが入っていると言うことは手打ちで投稿しているようですね。
コードをそのままコピーペイストしてください。
そして、インデントをしっかりつけると、頭が整理できると思いますよ。
変数の初期化が問題のようですから、そこも端折らずに投稿してみてください。

【60807】Re:[無題]
発言  新参者2  - 09/3/16(月) 14:42 -

引用なし
パスワード
   ▼横入り さん:
端折っている部分もございますが、だいたい下記の内容が主要です。
ただ不要な部分が多いことや下記内容では伝わらないかもしれませんが、
そのときはご返信ください。

----------------------------------------
ユーザーフォーム  'ユーザーフォーム1の後、下記ユーザーフォームが開く

Sub commandbutton1_click()

Dim folderPath As String

Dim FileNames
 Dim CSVname As String
 Dim tmpSheet As Worksheet '開くCsvファイル
 Dim ActSheet As Worksheet 'コピー先シート
 Dim a As Long, e As Long, g As Long
 Dim b As Long, f As Long
 Dim c As Long
 Dim d As Long
 Dim h As Long, i As Long, j As Long, k As Long
 Dim l As Long, m As Long, n As Long, o As Long
 Dim p As Long, q As Long, r As Long, s As Long
 Dim t As Long, u As Long
 
 
If OptionButton1 = True Then 
 'ユーザーフォームにあるオプションボタン1つの動作

Unload UserForm1

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")

 b = sh2.Cells(6, 8).Value
 c = sh2.Cells(5, 21).Value
 d = sh2.Cells(7, 6).Value

   
CreateObject("WScript.Shell").CurrentDirectory = "○○"
  FileNames = Application.GetOpenFilename("CSV File,*.csv", MultiSelect:=True)
  If VarType(FileNames) = vbBoolean Then Exit Sub

   Set ActSheet = ActiveSheet
  Application.ScreenUpdating = False
  e = 1 'コピー列
  For a = 1 To UBound(FileNames)
    CSVname = Mid$(FileNames(a), InStrRev(FileNames(a), "\") + 1)
    ActSheet.Cells(1, e).Value = CSVname
    ActSheet.Cells(2, e).Value = "○○"
    Set tmpSheet = Workbooks.Open(FileNames(a), Local:=True).Sheets(1)
    With tmpSheet
      .Cells(c, 1).Resize(b).Copy ActSheet.Cells(3, e)
      .Parent.Close False
    End With
    Set tmpSheet = Nothing
    e = e + 4
    
    
  Next
  Application.CutCopyMode = False
  Application.ScreenUpdating = False
  
  f = 2
  For g = 1 To UBound(FileNames)
  
  ActSheet.Cells(2, f).Value = "○○"
  Set tmpSheet = Workbooks.Open(FileNames(g), Local:=True).Sheets(1)
    With tmpSheet
      .Cells(c, 2).Resize(b).Copy ActSheet.Cells(3, f)
      .Parent.Close False
    End With
    Set tmpSheet = Nothing
    f = f + 4
        
  Next
  Application.CutCopyMode = False
  Application.ScreenUpdating = False
  
  h = 3
  For i = 1 To UBound(FileNames)
  
  ActSheet.Cells(2, h).Value = "○○"
  Set tmpSheet = Workbooks.Open(FileNames(i), Local:=True).Sheets(1)
    With tmpSheet
      .Cells(c, 3).Resize(b).Copy ActSheet.Cells(3, h)
      .Parent.Close False
    End With
    Set tmpSheet = Nothing
    h = h + 4
        
  Next
  Application.CutCopyMode = False
  Application.ScreenUpdating = False


End If


列数を取得

Date1

End Sub

-------------------------------------------
モジュール1
-----------------------------------------------------
Sub Date1()

Set sh1 = Sheets("sheet1")
Set sh2 = Sheets("sheet2")

Dim u As Long, t As Long
Dim h As Long
Dim w As Integer
Dim x As Integer
Dim o As Long, p As Long
Dim r As Single

t = sh2.Cells(4, 2).Value
h = sh2.Cells(6, 8).Value

u = 2
If u <= t * 4 Then

For w = u To 4 * t

 If sh1.Cells(3, u).Value = "" Then
  
   Exit For

sh1.Select
Cells.Clear
  
 End If

x = sh1.Cells(65536, u).End(xlUp).Row
sh2.Cells(18, 8).Value = x

If sh1.Cells(3, u).Value <> "" Then
sh1.Cells(2, u + 2).Value = "○○"
End If

For o = 3 To x

sh1.Cells(o, u + 2).FormulaR1C1 = "=RC[-1]/1000+RC[-2]"

Selection.NumberFormatLocal = "G/標準"
Selection.NumberFormatLocal = "0.000_ "

Next o


sh1.Select
Cells(3, u + 2).Resize(x).Select
Charts.Add
 ActiveChart.ChartType = xlLineMarkers

    
  ActiveChart.Axes(xlValue).MajorGridlines.Select
  With Selection.Border
    .ColorIndex = 2
    .Weight = xlHairline
    .LineStyle = xlContinuous
  End With

  ActiveChart.Axes(xlCategory).Select
  With Selection.Border
    .Weight = xlHairline
    .LineStyle = xlAutomatic
  End With
  With Selection
    .MajorTickMark = xlInside
    .MinorTickMark = xlNone
    .TickLabelPosition = xlNone
  End With
  ActiveChart.Axes(xlCategory).Select
  With ActiveChart.Axes(xlCategory)
    .CrossesAt = 1
    .TickLabelSpacing = 1
    .TickMarkSpacing = 1
    .AxisBetweenCategories = True
    .ReversePlotOrder = False
  End With
   
  ActiveChart.PlotArea.Select
  ActiveChart.SeriesCollection(1).Name = sh1.Cells(2, u + 2).Value
  
  With Selection.Border
    .Weight = xlHairline
    .LineStyle = xlAutomatic
  End With
  With Selection.Interior
    .ColorIndex = 2    'グラフの領域を白にする
    .PatternColorIndex = 1
    .Pattern = xlSolid
  End With
  
  With ActiveChart
    .HasTitle = True
    .ChartTitle.Characters.Text = sh1.Cells(1, u - 1).Value
  End With


  ActiveChart.SeriesCollection(1).Select
  With Selection
    .MarkerBackgroundColorIndex = xlAutomatic
    .MarkerForegroundColorIndex = xlAutomatic
    .MarkerStyle = xlNone
    .Smooth = False
    .MarkerSize = 5
    .Shadow = False
  End With
  
  ActiveChart.SeriesCollection(1).Select
 
  
  With Selection
    .MarkerBackgroundColorIndex = xlAutomatic
    .MarkerForegroundColorIndex = xlAutomatic
    .MarkerStyle = xlNone
    .Smooth = False
    .MarkerSize = 5
    .Shadow = False
  End With

   
u = u + 4

Next w


Else
MsgBox "値がおかしいです。"

End If


End Sub

---------------------------------------
モジュール2
---------------------------------------
列数

Sub 列数を取得()

Set sh1 = Sheets("sheet1")
Dim 列数 As Integer
Dim t As Long, w As Long

t = 1
For 列数 = t To 256

If sh1.Cells(3, t + 1).Value = "" And sh1.Cells(3, t + 2).Value = "" Then
 w = t + 1
Sheet2.Select
Sheet2.Cells(2, 2).Value = w
Exit For
End If

t = t + 1
Next 列数

End Sub

-------------------------
モジュール3
--------------------------------
Sub 最終行数カウント()

Dim e As Long, num As Integer

Set sh2 = Sheets("sheet2")
Set sh1 = Sheets("sheet1")

If sh1.Range("A2:B5").CurrentRegion.Rows.Count = "" Then

 Exit Sub

Else

e = sh1.Range("A2:B5").CurrentRegion.Rows.Count
sh2.Cells(17, 8).Value = e

num = sh1.Range("F65536").End(xlUp).Row
sh2.Cells(18, 8).Value = num

End If

End Sub

【60808】Re:[無題]
発言  kanabun  - 09/3/16(月) 16:36 -

引用なし
パスワード
   ▼新参者2 さん:

> t = sh2.Cells(4, 2).Value
> u = 2
> If u <= t * 4 Then
>   For w = u To 4 * t
>     u = u + 4
>   Next w
>
> Else
>  MsgBox "値がおかしいです。"
> End If

ここの
>   For w = u To 4 * t
の部分だけとりだすと、↓こういう構文になります。
Sub Test1()
 Dim t As Long
 Dim w As Long
 Dim u As Long
 t = 4 'かりに t = 4 とする
 u = 2
 For w = u To t * 4
   Debug.Print "w="; w, "u="; u
   u = u + 4
 Next
End Sub
これを実行すると、イミディエイト・ウィンドウに こう表示されます。

w= 2     u= 2
w= 3     u= 6
w= 4     u= 10
w= 5     u= 14
w= 6     u= 18
w= 7     u= 22
w= 8     u= 26
w= 9     u= 30
w= 10     u= 34
w= 11     u= 38
w= 12     u= 42
w= 13     u= 46
w= 14     u= 50
w= 15     u= 54
w= 16     u= 58


▼実際は uを初期値2 から Step 4 づつ 回したいのではないですか?
Sub Test2()
 Dim t As Long
 Dim u As Long
 t = 4
 For u = 2 To t * 4 Step 4
   Debug.Print "u="; u
 Next
End Sub
----------------- イミディエイト・ウィンドウの出力
u= 2
u= 6
u= 10
u= 14

【60809】Re:[無題]
発言  新参者3  - 09/3/16(月) 17:34 -

引用なし
パスワード
   ▼kanabun さん:
ご返答ありがとうございます。
Wというのはファイルの数で、1つのファイルに列が3つあり4列目(D列)に2列目と3列目の演算式を入れます。
ファイルの数は任意で、ファイルが2つあれば2つ目のファイルの4列目(H列目)にはD列と同じ演算式を入れるというFor文です。
つまり、ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。

よろしくお願い致します。

>▼新参者2 さん:
>
>> t = sh2.Cells(4, 2).Value
>> u = 2
>> If u <= t * 4 Then
>>   For w = u To 4 * t
>>     u = u + 4
>>   Next w
>>
>> Else
>>  MsgBox "値がおかしいです。"
>> End If
>
>ここの
>>   For w = u To 4 * t
>の部分だけとりだすと、↓こういう構文になります。
>Sub Test1()
> Dim t As Long
> Dim w As Long
> Dim u As Long
> t = 4 'かりに t = 4 とする
> u = 2
> For w = u To t * 4
>   Debug.Print "w="; w, "u="; u
>   u = u + 4
> Next
>End Sub
>これを実行すると、イミディエイト・ウィンドウに こう表示されます。
>
>w= 2     u= 2
>w= 3     u= 6
>w= 4     u= 10
>w= 5     u= 14
>w= 6     u= 18
>w= 7     u= 22
>w= 8     u= 26
>w= 9     u= 30
>w= 10     u= 34
>w= 11     u= 38
>w= 12     u= 42
>w= 13     u= 46
>w= 14     u= 50
>w= 15     u= 54
>w= 16     u= 58
>
>
>▼実際は uを初期値2 から Step 4 づつ 回したいのではないですか?
>Sub Test2()
> Dim t As Long
> Dim u As Long
> t = 4
> For u = 2 To t * 4 Step 4
>   Debug.Print "u="; u
> Next
>End Sub
>----------------- イミディエイト・ウィンドウの出力
>u= 2
>u= 6
>u= 10
>u= 14

【60810】Re:[無題]
発言  新参者3  - 09/3/16(月) 17:39 -

引用なし
パスワード
   ▼kanabun さん:

更に付け加えますと、
uの位置は、前使っていたマクロの使い回しのため、
u+2と指定しております。

ここを変えても問題はないのですが、
変えなくても問題ないと思いますので変えておりません。


> t = sh2.Cells(4, 2).Value
> u = 2
> If u <= t * 4 Then ←ここのif文ももっと良い方法がありますが、当時はこれでやりましたのでそのまま載せました。これも問題ないとは思うのですが・・・
>   For w = u To 4 * t
>     u = u + 4
>   Next w

【60811】Re:[無題]
発言  kanabun  - 09/3/16(月) 17:49 -

引用なし
パスワード
   ▼新参者3 さん:

>つまり、ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。

ファイルの数というのは そこでいう 変数t のことではなかったですか?
どうして 4列づつ (つまり Step 4 )ではないのですか??
わかりませんね〜

【60813】Re:[無題]
発言  新参者4  - 09/3/16(月) 18:04 -

引用なし
パスワード
   ▼kanabun さん:
>▼新参者3 さん:
>
>>つまり、ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。
>
>ファイルの数というのは そこでいう 変数t のことではなかったですか?
>どうして 4列づつ (つまり Step 4 )ではないのですか??
>わかりませんね〜

いや、この方法でできると思っていたもので・・・

知識不足のため、あまり構文を熟知していないものでして、申し訳ないです。

stepにしますと、
変数t分step数を制限できる。
これでやってみます。

【60821】Re:[無題]
質問  新参者5  - 09/3/17(火) 0:48 -

引用なし
パスワード
   ▼kanabun さん:

お世話になります。
uの配列は貴殿がおっしゃる通りに組んだ場合、
公式(演算式)を参照する列はズレないのですか?

まだ貴殿のマクロを実行していませんので何とも言えませんが・・・

私が組んだVBAだと、U+2列の演算式の参照する列がズレる訳を
できましたらお教え頂けないでしょうか。

更に質問させて頂きますと、
Wは確かにいらない変数ですが、
Wがあっても問題にならないのでは・・・

申し訳ございません。 まだまだ知識不足のため、ご教授頂きたいです。

【60825】Re:[無題]
発言  kanabun  - 09/3/17(火) 9:43 -

引用なし
パスワード
   ▼新参者5 さん:

>>ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。

ほんとにそうですか?
前に提示したCheckプログラムにちょっと追加したものです↓。
試してみてください。

Sub Test1b()
 Dim t As Long
 Dim w As Long
 Dim u As Long
 t = 4  'ファイル数
 u = 2
 For w = u To t * 4
   Debug.Print "w="; w, "u="; u, "(u+2)列="; AlphaCol(u + 2)
   u = u + 4
 Next
End Sub

Sub Test2b()
 Dim t As Long
 Dim w As Long
 Dim u As Long
 t = 4  'ファイル数
 For u = 2 To t * 4 Step 4
   Debug.Print "u="; u, "(u+2)列="; AlphaCol(u + 2)
 Next
End Sub

Function AlphaCol(i As Long) As String
 Dim n As Long, m As Long
 Dim ss As String
  n = (i - 1) \ 26       '上位 Alphabet
  m = (i - 1) Mod 26      '下位 Alphabet
  If n Then ss = Chr$(&H40 + n)
  AlphaCol = ss & Chr$(&H41 + m)
End Function

ファイルが4つのとき( t = 4のとき)
Sub Test1b() の結果は こうです。
w= 2     u= 2     (u+2)列=D
w= 3     u= 6     (u+2)列=H
w= 4     u= 10     (u+2)列=L
w= 5     u= 14     (u+2)列=P
w= 6     u= 18     (u+2)列=T
w= 7     u= 22     (u+2)列=X
w= 8     u= 26     (u+2)列=AB
w= 9     u= 30     (u+2)列=AF
w= 10     u= 34     (u+2)列=AJ
w= 11     u= 38     (u+2)列=AN
w= 12     u= 42     (u+2)列=AR
w= 13     u= 46     (u+2)列=AV
w= 14     u= 50     (u+2)列=AZ
w= 15     u= 54     (u+2)列=BD
w= 16     u= 58     (u+2)列=BH

(u+2)の 列は D,H,L,P ... と変化していますよ?
さらに、BH列までループしてますよ? ファイルは4つなのに??


>uの配列は貴殿がおっしゃる通りに組んだ場合、
>公式(演算式)を参照する列はズレないのですか?
ですから、正解の列番号の並びが D,H,L,P,X... であれば ズレは無いといえるし、
>>ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。
であれば、 Step 4 のルールを途中で逸脱しているから、ズレは必ず生じると
いえます。
>
>まだ貴殿のマクロを実行していませんので何とも言えませんが・・・

>私が組んだVBAだと、U+2列の演算式の参照する列がズレる訳を
>できましたらお教え頂けないでしょうか。

何をどうやっているかについての説明が不十分ですので、「訳」はこちらでは
わかりません。
どうかステップ実行して 変数の変化と処理の流れをご自分でデバッグしてください

>
>更に質問させて頂きますと、
>Wは確かにいらない変数ですが、
>Wがあっても問題にならないのでは・・・

不要な変数は削除して、プログラムの可読性を高めるべきです。

可読性といえば、さんざん言われていることですが、
インデントをしっかりつけましょう。

【60829】Re:[無題]
お礼  新参者4  - 09/3/17(火) 13:47 -

引用なし
パスワード
   ▼kanabun さん:

確かにWは下記の設定で16までループ致しますね。
しかし、Uの設定範囲を設けておりますが、
効果なしということなのでしょうか??

貴殿のプログラムでマクロを組んでみます。
ありがとうございました。


>▼新参者5 さん:
>
>>>ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。
>
>ほんとにそうですか?
>前に提示したCheckプログラムにちょっと追加したものです↓。
>試してみてください。
>
>Sub Test1b()
> Dim t As Long
> Dim w As Long
> Dim u As Long
> t = 4  'ファイル数
> u = 2
> For w = u To t * 4
>   Debug.Print "w="; w, "u="; u, "(u+2)列="; AlphaCol(u + 2)
>   u = u + 4
> Next
>End Sub
>
>Sub Test2b()
> Dim t As Long
> Dim w As Long
> Dim u As Long
> t = 4  'ファイル数
> For u = 2 To t * 4 Step 4
>   Debug.Print "u="; u, "(u+2)列="; AlphaCol(u + 2)
> Next
>End Sub
>
>Function AlphaCol(i As Long) As String
> Dim n As Long, m As Long
> Dim ss As String
>  n = (i - 1) \ 26       '上位 Alphabet
>  m = (i - 1) Mod 26      '下位 Alphabet
>  If n Then ss = Chr$(&H40 + n)
>  AlphaCol = ss & Chr$(&H41 + m)
>End Function
>
>ファイルが4つのとき( t = 4のとき)
>Sub Test1b() の結果は こうです。
>w= 2     u= 2     (u+2)列=D
>w= 3     u= 6     (u+2)列=H
>w= 4     u= 10     (u+2)列=L
>w= 5     u= 14     (u+2)列=P
>w= 6     u= 18     (u+2)列=T
>w= 7     u= 22     (u+2)列=X
>w= 8     u= 26     (u+2)列=AB
>w= 9     u= 30     (u+2)列=AF
>w= 10     u= 34     (u+2)列=AJ
>w= 11     u= 38     (u+2)列=AN
>w= 12     u= 42     (u+2)列=AR
>w= 13     u= 46     (u+2)列=AV
>w= 14     u= 50     (u+2)列=AZ
>w= 15     u= 54     (u+2)列=BD
>w= 16     u= 58     (u+2)列=BH
>
>(u+2)の 列は D,H,L,P ... と変化していますよ?
>さらに、BH列までループしてますよ? ファイルは4つなのに??
>
>
>>uの配列は貴殿がおっしゃる通りに組んだ場合、
>>公式(演算式)を参照する列はズレないのですか?
>ですから、正解の列番号の並びが D,H,L,P,X... であれば ズレは無いといえるし、
>>>ファイルが4つあれば演算式の列は、D列、H列、L列、O列です。
>であれば、 Step 4 のルールを途中で逸脱しているから、ズレは必ず生じると
>いえます。
>>
>>まだ貴殿のマクロを実行していませんので何とも言えませんが・・・
>
>>私が組んだVBAだと、U+2列の演算式の参照する列がズレる訳を
>>できましたらお教え頂けないでしょうか。
>
>何をどうやっているかについての説明が不十分ですので、「訳」はこちらでは
>わかりません。
>どうかステップ実行して 変数の変化と処理の流れをご自分でデバッグしてください
>。
>>
>>更に質問させて頂きますと、
>>Wは確かにいらない変数ですが、
>>Wがあっても問題にならないのでは・・・
>
>不要な変数は削除して、プログラムの可読性を高めるべきです。
>
>可読性といえば、さんざん言われていることですが、
>インデントをしっかりつけましょう。

【60830】Re:[無題]
発言  新参者6  - 09/3/17(火) 14:08 -

引用なし
パスワード
   ▼kanabun さん:

貴殿のマクロで実行しましたが、
やはり問題の下記のfor文(演算式で・・・)バグが起こります。

For o = 3 To x

sh1.Cells(o, u + 2).FormulaR1C1 = "=RC[-1]/1000+RC[-2]"

Selection.NumberFormatLocal = "G/標準"  ←ここでバグが起こります。
Selection.NumberFormatLocal = "0.000_ "

Next o

ファイル2個(t=2)のとき、
D列(u+2列)はちゃんと演算式が合っている。
次のH列(u+2列)の演算式が 
[通常] B列/1000*C列 に対して

[バグ] IV列/1000+IU列
となっています。

良い方法をお教え頂けないでしょうか。

【60831】Re:全体の流れを確認しましょう
発言  kanabun  - 09/3/17(火) 14:24 -

引用なし
パスワード
   ▼新参者6 さん:
>▼kanabun さん:
>
>貴殿のマクロで実行しましたが、
>やはり問題の下記のfor文(演算式で・・・)バグが起こります。
>
>For o = 3 To x
>
>sh1.Cells(o, u + 2).FormulaR1C1 = "=RC[-1]/1000+RC[-2]"
>
>Selection.NumberFormatLocal = "G/標準"  ←ここでバグが起こります。
>Selection.NumberFormatLocal = "0.000_ "
>
>Next o

それは Selection(選択されているもの)が sh1.Cells(o, u + 2) ではない
からではないですか?
それに、1行づつ数式をセットする必要はありませんよ

>良い方法をお教え頂けないでしょうか。

インデントつけて、全体の流れをもう少しスリムにまとめてみてください。
細かいところは省略して、おおむねこういことをしたいのではないでしょうか?

1.読み込むCSVファイルの選択
2.選択されたCSVファイルを順番に読み込み、指定の範囲(3列)を
 ActSheetの3行目以降に 貼り付ける。
   最初のCSVデータは A,B,C列
   2番目のCSVデータは E,F,G列
     :
   4列おきに......

3.貼り付けた3列データの横(4列目)に 数式"=RC[-1]/1000+RC[-2]"
 をセットする。
 また、この列を用いてグラフを描く。(グラフシート Charts.Add)


Sub commandbutton1_click()
 Dim Sh2 As Worksheet
 Dim folderPath As String
 Dim FileNames
 Dim CSVname As String
 Dim CsvSheet As Worksheet '開くCsvファイル
 Dim ActSheet As Worksheet 'コピー先シート
 Dim a As Long, e As Long
 Dim b As Long
 Dim c As Long
 Dim d As Long
 Dim t As Long '読み込むCSVファイルの数

  If OptionButton1.Value = False Then Exit Sub

  Unload UserForm1
  
  '複数CSVファイルを指定
  CreateObject("WScript.Shell").CurrentDirectory = "○○"
  FileNames = Application.GetOpenFilename( _
        "CSV File,*.csv", MultiSelect:=True)
  If VarType(FileNames) = vbBoolean Then Exit Sub

  Set Sh2 = Sheets("Sheet2")          '【読み込む範囲の確認】
  b = Sh2.Cells(6, 8).Value 'CSVファイルから読み込む行数
  c = Sh2.Cells(5, 21).Value ' 読み込む最初の列(3列読み込み)
  If MsgBox(c & "列から" & c + 2 & "列より " & b & "行読み込みます", _
    vbOKCancel) = vbCancel Then Exit Sub
  
  Set ActSheet = ActiveSheet
  Application.ScreenUpdating = False
  e = 1 '最初のコピー先列番号
  t = UBound(FileNames) '読み込むCSVファイルの数
  For a = 1 To t
    CSVname = Mid$(FileNames(a), InStrRev(FileNames(a), "\") + 1)
    ActSheet.Cells(1, e).Value = CSVname
    ActSheet.Cells(2, e).Value = "○○"
    'CSVファイルを開き、
    ' 1列目のc行目から b行,3列分を _
           → ActSheetの(e) 列3行目以降に貼り付け
    With Workbooks.Open(FileNames(a), Local:=True).Sheets(1)
      .Cells(c, 1).Resize(b, 3).Copy ActSheet.Cells(3, e)
      .Parent.Close False
    End With
    'D,H,L,P,T,X ...列に 【数式と書式】をセットして【グラフ作成】
    With ActSheet.Cells(3, e + 3).Resize(b)
       .FormulaR1C1 = "=RC[-1]/1000+RC[-2]"
       .NumberFormatLocal = "0.000_ "
       グラフ作成 Source:=.Cells, _
             SeriesName:=.Item(-1, -1), _
             Title:=.Item(-2, -2)
    End With
    e = e + 4
  Next
  
  Date1
  Application.ScreenUpdating = True

End Sub

'-----------------------------------------------------
'モジュール1
'-----------------------------------------------------
Sub グラフ作成(Source As Range, SeriesName As Range, Title As Range)
   With Charts.Add
     .ChartType = xlLineMarkers
     .SetSourceData Source
     With .Axes(xlValue).MajorGridlines.Border
       .ColorIndex = 2
       .Weight = xlHairline
       .LineStyle = xlContinuous
     End With
     '// 省略
     .SeriesCollection(1).Name = SeriesName
     '// 省略
   
     .HasTitle = True
     .ChartTitle.Characters.Text = Title
   End With
End Sub

【60832】Re:全体の流れを確認しましょう
発言  kanabun  - 09/3/17(火) 15:00 -

引用なし
パスワード
   失礼しました

>    With Workbooks.Open(FileNames(a), Local:=True).Sheets(1)
>      .Cells(c, 1).Resize(b, 3).Copy ActSheet.Cells(3, e)
>      .Parent.Close False
>    End With

だから、↓の確認メッセージは

  c = Sh2.Cells(5, 21).Value ' 読み込む最初の行
  b = Sh2.Cells(6, 8).Value 'CSVファイルから読み込む行数
  If MsgBox("A,B,C列を " & c & "行目から " & & b & "行読み込みます", _
    vbOKCancel) = vbCancel Then Exit Sub

でないといけなかったですね?

【60843】Re:全体の流れを確認しましょう
回答  新参  - 09/3/17(火) 17:48 -

引用なし
パスワード
   ▼kanabun さん:
>失礼しました
>
>>    With Workbooks.Open(FileNames(a), Local:=True).Sheets(1)
>>      .Cells(c, 1).Resize(b, 3).Copy ActSheet.Cells(3, e)
>>      .Parent.Close False
>>    End With
>
>だから、↓の確認メッセージは
>
>  c = Sh2.Cells(5, 21).Value ' 読み込む最初の行
>  b = Sh2.Cells(6, 8).Value 'CSVファイルから読み込む行数
>  If MsgBox("A,B,C列を " & c & "行目から " & & b & "行読み込みます", _
>    vbOKCancel) = vbCancel Then Exit Sub
>
>でないといけなかったですね?

【60844】Re:全体の流れを確認しましょう
発言  kanabun  - 09/3/17(火) 18:17 -

引用なし
パスワード
   ▼新参 さん:


>>でないといけなかったですね?

もしや、まるで違ってましたですか?
そうなら、失礼しました。

3668 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free