| |
▼新参者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ファイルを順番に読み込み、指定の範囲（３列）を
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
|
|
kanabun
- 09/3/17(火) 14:24 -
