FC2ブログ

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

リスト作成とFLGつけ

Sub fopen()

Dim filename As String
Dim data As String
Dim n As Long

data = "data"

filename = Application.GetOpenFilename

If filename <> "False" Then
ans = MsgBox(filename & "を読み込みます", vbOKCancel, "読み込み確認")
If ans = vbOK Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = data
Workbooks.Open filename
Name = ActiveWorkbook.Name
Range("A1").CurrentRegion.Select
Selection.Copy
ThisWorkbook.Sheets(data).Range("A1").PasteSpecial
Workbooks(Name).Close
Else
MsgBox "終了します"
End
End If

Else
MsgBox "終了します"
End
End If

'入力規則のリスト作成
Sheets(data).Select
n = Sheets(data).Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(2, 3), Cells(n, 3)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("設定").Range("B1"), Unique:=True

Sheets("設定").Select
n = Sheets("設定").Cells(Rows.Count, 2).End(xlUp).Row
With Range("A1:A10").Cells.Validation
.Delete
.Add Type:=xlValidateList, Formula1:="=設定!$B$1:$B$" & n

End With




End Sub


flgつけ
Sub kib()

Dim bubann As Long
bubann = Sheets("設定").Cells(Rows.Count, 1).End(xlUp).Row - 1
Dim buban() As String
ReDim buban(bubann)

For i = 0 To bubann - 1
buban(i) = Cells(i + 2, 1)
Next

Dim i As Long
Dim k As Long
Dim katan As Long
katan = Cells(Rows.Count, 4).End(xlUp).Row - 1

Dim n As Long
Dim kata() As String
Dim katanum() As Long
ReDim kata(katan)
ReDim katanum(katan)

Sheets("設定").Select
katan = Cells(Rows.Count, 4).End(xlUp).Row - 1
For i = 0 To katan - 1
kata(i) = Cells(i + 2, 3)
katanum(i) = Cells(i + 2, 4)
Next

Sheets("data").Select
n = Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row
m = Sheets("data").Cells(1, Columns.Count).End(xlToLeft).Column

Cells(2, m + 1).Resize(n - 1).Formula = "=Left(A2, 3)"
Cells(2, m + 2).Resize(n - 1).Formula = "=value(Right(A2, 3))"

For i = 0 To katan - 1
For k = 0 To n - 1
If Cells(2 + k, 5) = kata(i) And Cells(2 + k, 6) >= katanum(i) Then
Cells(2 + k, 7) = "対象"
End If
Next k
Next i


For i = 0 To bubann - 1
For k = 0 To n - 1
If Cells(2 + k, 3) = buban(i) Then
Cells(2 + k, 7) = "対象"
End If
Next k
Next i


End Sub
スポンサーサイト
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

マージ

a<-read.csv("A.csv",header=T)
b<-read.csv("B.csv",header=T)
a[,2]<-as.Date(a[,2])
b[,2]<-as.Date(b[,2])

akey<-a[,c(1,2)]
akey[,1:2]<-paste(a[,1],a[,2],sep="")
bkey<-b[,c(1,2)]
bkey[,1]<-paste(b[,1],b[,2],sep="")


j<-0
k<-1
bkey<-merge(bkey,akey,by.x="No",by.y="No",all.x=T)
for (i in 1:10){
k<-k*i
j<-j+k
akey[,1]<-paste(a[,1],a[,2]+j,sep="")
bkey<-merge(bkey,akey,by.x="No",by.y="No",all.x=T)
bkey[,3]<-ifelse(is.na(bkey[,3]),bkey[,i+2],bkey[,3])
k<-k/abs(k)*(-1)
}
b[,"key"]<-bkey[,3]
a[,"key"]<-akey[,2]
a_out<-merge(a,b,by.x="key",by.y="key",all.x=T)
↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

テスト

Sub stap()

Dim cv As Integer
Dim m As Integer
Dim m_mrow As Integer
Dim koukan As Integer


cv = Range("B4")
m = Range("B6")
koukan = Range("B8")
m_mrow = Cells(Rows.Count, 14).End(xlUp).Row

Range("L:L").Clear
Range("P:P").Clear
Range("R:AB").Clear
Range("AC5").CurrentRegion.Clear
Range("G5").CurrentRegion.Clear

Range("L5").Resize(cv).Formula = "=K5/$B$5"
Range("P5").Resize(m).Formula = "=O5+P4"
Range("M5") = 0
Range("M6").Resize(m - 1).Formula = "=R7C2+R[-1]C"

For i = 0 To cv - 1
Cells(1, 19 + i) = Cells(5 + i, 10)
Cells(2, 19 + i) = Cells(5 + i, 12)
Cells(3, 19 + i) = "=Roundup(R3C2/R[-2]C,0)"

Next

For J = 0 To koukan - 1
For k = 0 To cv - 1
Sheets("Sheet1").Cells(5, 19 + k).Resize(m).Formula = _
"=IF(RC13/R3C>=" & J + 1 & ",1+R[-1]C,0)"
Sheets("Sheet1").Cells(5, 19 + k + J * cv + cv).Resize(m).Formula = _
"=IFERROR(VLOOKUP(RC[-" & cv + J * cv & "],R5C13:R" & m_mrow & "C15,3,FALSE),0)*R2C[-" & cv + J * cv & "]"

Next
Range(Cells(5, 29 + J * cv), Cells(m_mrow, 29 + J * cv + cv - 1)).Copy
Range(Cells(5, 29 + J * cv), Cells(m_mrow, 29 + J * cv + cv - 1)).PasteSpecial Paste:=xlPasteValues
Next

Range("R5").Resize(m).Formula = "=sum(RC[" & cv + 1 & "]:RC[" & cv + cv * koukan & "])"
Range("G5").Resize(m).Formula = "=R5/P5"
Range("H5").Resize(m).Formula = "=Q5/P5"


End Sub ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

その他

★チェックボックスで0/1 を入力

Private Sub check_Click()
If Sheets("平均値").Range("H2") = 1 Then

Sheets("平均値").Range("H2") = 0

Else
Sheets("平均値").Range("H2") = 1
End If

End Sub

★文字ラベルにセルを参照させる方法

Private Sub Tx_wid_Change()
Sheets("平均値").Cells(14, 2) = Me.Tx_wid.Text
End Sub

Private Sub UserForm_Initialize()


Me.Controls("Label1").Caption = "お勧めは5000分割の " & Sheets("平均値").Cells(14, 2) & " です"
Me.Tx_wid.Text = Sheets("平均値").Cells(14, 2)

End Sub ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑

平均値の推移

Sub avesuii()

Dim n As Double

Sheets("死亡平均").Select
Sheets("死亡平均").AutoFilterMode = False
Sheets("死亡平均").Range("A:C").Clear

Sheets("WPP").Select
n = Sheets("WPP").Cells(Rows.Count, 1).End(xlUp).row
Sheets("WPP").Range(Cells(1, 1), Cells(n, 3)).Copy Destination:=Sheets("死亡平均").Range("A1")

Sheets("死亡平均").Select
Sheets("死亡平均").Range(Cells(1, 1), Cells(n, 3)).Sort Key1:=Sheets("死亡平均").Cells(1, 1), order1:=xlAscending, Header:=xlYes
Sheets("死亡平均").Range("D2").Resize(n - 1).Formula = "=average($B$2:B2)"




End Sub ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓ ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
プロフィール

abc

Author:abc
このブログの内容に真実はありません。

最新記事
最新コメント
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。