月別: 2017年9月

勘定科目ソート

key:=Range(“C4”) 第一優先キーは勘定科目
Order1:=xlAsending 第一優先キーの並び順は昇順
Header:=xlGuess 見出しの有無はデータに依存

日付ソート

勘定科目ソート

key:=Range(“Ａ4”) 第一優先キーは日付
Order1:=xlAsending 第一優先キーの並び順は昇順
Header:=xlGuess 見出しの有無はデータに依存

 

Sub 勘定科目ソート()
Worksheets(“元帳”).Activate
Cells(4, 1).CurrentRegion.Select
Selection.Sort Key1:=Range(“C4”), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin

End Sub

Sub 日付ソート()
Worksheets(“元帳”).Activate
Cells(4, 1).CurrentRegion.Select
Selection.Sort Key1:=Range(“A4”), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin

End Sub

選択併合

private su sheetmarge(sname as string)

snameはサブルーチんが呼び出されるときに実際の
値が確定。
sub プロシージャーは２回呼び出される。
１度目は銀行預金シート
２度目は現金シート
dp1 dp2 はモジュール全体で有効

Option Explicit
Dim Dp1 As Integer      ‘元帳を追加する行番号を保持
Dim Dp2 As Integer      ‘手持金を追加する行番号を保持
Const Sp As Integer = 4   ‘定数を定義。追加する際の先頭の行番号

Sub 併合()
Worksheets(“元帳”).Cells(3, 1).CurrentRegion.Offset(1, 0).Clear
Dp1 = Sp  ‘4行目から記入

Worksheets(“手持金”).Cells(3, 1).CurrentRegion.Offset(1, 0).Clear
Dp2 = Sp  ‘4行目から記入

SheetMarge “銀行預金”
SheetMarge “現金”
End Sub

Private Sub SheetMarge(sName As String)
Dim Ep As Integer, Cc As Integer

Worksheets(sName).Activate
Ep = Cells(Sp, 1).End(xlDown).Row
For Cc = Sp To Ep
If Cells(Cc, 3).Value = “手持ち金” Then
With Worksheets(“手持金”)
Range(Cells(Cc, 1), Cells(Cc, 7)).Copy .Cells(Dp2, 1) ‘.Paste
If Dp2 = Sp Then    ‘もし先頭行なら
.Cells(Dp2, 6).FormulaR1C1 = “=RC[-2]-RC[-1]”
Else
.Cells(Dp2, 6).FormulaR1C1 = “=R[-1]C+RC[-2]-RC[-1]”
End If
Dp2 = Dp2 + 1
End With
Else
With Worksheets(“元帳”)
Range(Cells(Cc, 1), Cells(Cc, 7)).Copy .Cells(Dp1, 1) ‘.Paste
If Dp1 = Sp Then    ‘もし先頭行なら
.Cells(Dp1, 6).FormulaR1C1 = “=RC[-2]-RC[-1]”
Else
.Cells(Dp1, 6).FormulaR1C1 = “=R[-1]C+RC[-2]-RC[-1]”
End If
Dp1 = Dp1 + 1
End With
End If
Next Cc
End Sub

 

併合

■CurrentRegionプロパティ
あるセルを起点としてデータの連続領域を返す。

■copy メソッド
引数がない場合はコピー元のオブジェクトをクリップボードにコピー。
引数がセルの場合は、セルにコピーする。

■Resize
resize(rowsize,columnsize)
指定されたセル範囲をかえす。

■cells(3,1).end(xldown).offset(1,0)
セル(3,1)の終端行End(xldown)の次の行
offset(1,0)をコピー先に

Option Explicit

Sub 併合()
Dim N As Integer

Worksheets(“元帳”).Activate
Cells(3, 1).CurrentRegion.Clear
Worksheets(“銀行預金”).Cells(3, 1).CurrentRegion.Copy Cells(3, 1)

With Worksheets(“現金”).Cells(3, 1).CurrentRegion
.Offset(1, 0).Resize(.Rows.Count – 1, .Columns.Count).Copy Cells(3, 1).End(xlDown).Offset(1, 0)
End With

Cells(4, 6).FormulaR1C1 = “=RC[-2]-RC[-1]”
N = Cells(4, 1).End(xlDown).Row
Range(Cells(5, 6), Cells(N, 6)).FormulaR1C1 = “=R[-1]C+RC[-2]-RC[-1]”
End Sub

 

関数を自分で宣言し、利用する。最大公約数マクロを、Imax関数として宣言しこれを引用する。

－－－－－－－－－－－－－－－－－－

Sub マクロ3()
Dim I As Long, J As Long, W As Long
I = Cells(2, 2).Value
J = Cells(3, 2).Value

Cells(4, 1).Value = “最大公約数”
Cells(4, 2).Value = Imax(I, J)
End Sub

Function Imax(ByVal Ii As Long, ByVal Jj As Long) As Long
Dim W As Long
While Ii <> 0
If Ii < Jj Then
W = Ii
Ii = Jj
Jj = W
End If
Ii = Ii Mod Jj
Wend
Imax = Jj
End Function

Ｅxcel sheetを作る

フォームを作成

ラベル・テキストボックス・リストボックス・コマンドボタン

 

イベントプロシジャーの作成

 

Option Explicit
——————–
Private Sub UserForm_Initialize()
‘リストボックスへのデータ表示
ListBox1.List = Sheets(“勘定科目”).Range(“B1:B23”).Value
‘月日の初期値
TextBox1.Text = Year(Now())
TextBox2.Text = Month(Now())
TextBox3.Text = Day(Now())
End Sub
——————–
Private Sub CommandButton2_Click()
‘［終了］ボタンクリック時の処理
Unload UserForm1
End Sub
———————–
Private Sub CommandButton1_Click()
Dim R As Integer
‘レコード出力位置の検出
R = Cells(3, 1).End(xlDown).Row + 1
‘フォームデータをセルに出力する
Cells(R, 1).Value = TextBox1.Text & “/” & TextBox2.Text & “/” & TextBox3.Text
Cells(R, 1).NumberFormatLocal = “yyyy/m/d”
Cells(R, 2).Value = TextBox4.Text       ‘摘要
Cells(R, 3).Value = ListBox1.Text       ‘勘定科目
Cells(R, 4).Value = TextBox5.Text       ‘入金
Cells(R, 4).Style = “Comma [0]”
Cells(R, 5).Value = TextBox6.Text       ‘出金
Cells(R, 5).Style = “Comma [0]”
If R <= 4 Then                          ‘残高
Cells(R, 6).FormulaR1C1 = “=RC[-2]-RC[-1]”
Else
Cells(R, 6).FormulaR1C1 = “=R[-1]C+RC[-2]-RC[-1]”
End If
Cells(R, 6).Style = “Comma [0]”
Cells(R, 7).Value = ListBox1.ListIndex  ‘ＩＤ
‘入力フィールドのクリア
TextBox4.Text = “”
TextBox5.Text = “”
TextBox6.Text = “”
ListBox1.ListIndex = -1
End Sub

最大公約数をＥＸＣＥＬＶＢＡ

Sub マクロ()
Dim i As Long, j As Long, w As Long
i = Cells(2, 2).Value
j = Cells(3, 2).Value
While i <> 0
If i <> 0 Then
w = i
i = j
j = w
End If
i = i Mod j
Wend
Cells(4, 1).Value = “最大公約数”
Cells(4, 2).Value = j

End Sub

 

WordPress へようこそ。これは最初の投稿です。編集もしくは削除してブログを始めてください !