konkensyu @ ウィキ

sample/karimoto-tyosa

2011-08-03T09:55:41+09:00

Option Explicit Sub 仮元帳チェックマクロ() ' 'エラーの際は「エラー処理」へ On Error GoTo エラー処理 '変数定義 Dim CYALL As Variant, 行数 As Variant, 列数 As Variant, データ名 As Variant '変数の値代入 CYALL = Worksheets(2).Name 行数 = Worksheets(1).Range("A1").End(xlDown).Row 列数 = Worksheets(Worksheets.Count).Range("B26") データ名 = ActiveWorkbook.Name '元帳操作 With Worksheets(1) .Range("O1").Value = "ST_部門ｺｰﾄﾞ" .Range("P1").Value = "ST_部門名称" .Range("Q1").Value = "判定" .Range("O2").Formula = "=VLOOKUP($K2,'" & CYALL & "'!$A$11:$AG$2000," & 列数 - 1 & ",0)" .Range("P2").Formula = "=VLOOKUP($K2,'" & CYALL & "'!$A$11:$AG$2000," & 列数 & ",0)" .Range("Q2").Formula = "=IF(OR(K2=0,K2=810002,K2=810064）,""OK"",IF(I2 = O2,""OK"",""NG""))" .Range("O2:Q2").Copy .Paste Range(.Range("O2"), .Cells(行数, 15)) 'OK行以外をオートフィル .Range("A1").AutoFilter Field:=17, Criteria1:="<>" & "OK" End With Exit Sub 'エラー発生時の処理エラー処理: MsgBox Err.Number & ":" & Err.Description End Sub

sample/sheet-3

2011-08-02T12:09:21+09:00

Sub ★シート並べ替え() Dim i As Integer, sRange As Range, sName As String Worksheets.Add(Before:=Worksheets(1)).Name = "temp" For i = 4 To Worksheets.Count - 1 Cells(i, 1) = Worksheets(i).Name Next Set sRange = Cells(4, 1).CurrentRegion With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending .SetRange sRange .Apply End With For i = 1 To sRange.Row.Count sName = Worksheets("temp").Cells(i + 3, 1) Worksheets(sName).Move after:=ActiveSheet Next Application.DisplayAlerts = False Worksheets("temp").DELETE Application.DisplayAlerts = True End Sub

sample/yojitsu

2011-08-02T12:08:02+09:00

Sub 予実FBファイル作成マクロ() 'エラー処理用 On Error GoTo errHandler '名称定義 Dim 作業フォルダ名 As String Dim マクロ名 As String Dim 予算ファイル名 As String Dim 予算シート名 As String Dim 保存名 As String Dim 対象シート As Variant '条件取得作業フォルダ名 = ThisWorkbook.Path '作業するフォルダのパスを取得マクロ名 = ActiveWorkbook.Name '起動マクロのファイル名取得予算ファイル名 = Range("C7").Value '予算反映するシート名取得 '対象カテゴリの指定 Set 対象シート = Application. _ InputBox(prompt:="予実FBを作成したいシート名を指定", Type:=8) '対象範囲指定対象シート.Select '対象のループ For Each 対象シート In Selection Workbooks(マクロ名).Worksheets(Worksheets.Count).Activate Range("C9").Value = 対象シート予算シート名 = Range("C9").Value '予算反映するシート名取得保存名 = 作業フォルダ名 & "\" & Range("C11").Value '保存名取得 '予算シートのコピー Workbooks(予算ファイル名).Activate Worksheets(予算シート名).Activate ActiveSheet.Range("F6:Q110").Copy ' ActiveSheet.Range("S5:AD109").Copy 'コピーした予算の貼付（値貼付） Workbooks(マクロ名).Worksheets("予算").Range("F6").PasteSpecial xlPasteValues '予算シート記入名称の代入 Workbooks(マクロ名).Worksheets(1).Range("E3").Value = 予算シート名 'データの保存 Workbooks(マクロ名).Worksheets(Array(1, 2, 3, 4, 5)).Copy '予実報告～対象表をコピー ActiveWorkbook.SaveAs Filename:=保存名 & ".xlsx", _ FileFormat:=xlOpenXMLWorkbook 'EXCEL2007形式で保存 Next Exit Sub errHandler: MsgBox Err.Description End Sub

sample/sheet-2

2011-08-02T12:07:12+09:00

Sub ★選択範囲で印刷設定() With ActiveSheet.PageSetup .PrintArea = Selection.Address '選択範囲が印刷範囲 .CenterHeader = "&16&A" '真ん中のヘッダー：16ポイントのシート名 .RightHeader = "&12&D" '右のヘッダー：12ポイントのToday .CenterFooter = "&P/&N" '真ん中のフッター：11ポイントのページ連番 .LeftMargin = Application.InchesToPoints(0.31496062992126) .RightMargin = Application.InchesToPoints(0.31496062992126) .TopMargin = Application.InchesToPoints(0.551181102362205) .BottomMargin = Application.InchesToPoints(0.354330708661417) .HeaderMargin = Application.InchesToPoints(0.196850393700787) .FooterMargin = Application.InchesToPoints(0.118110236220472) .CenterHorizontally = True '左右中央 .Orientation = xlPortrait '印刷方向縦書き .Zoom = False '拡大/縮小の設定オフ .FitToPagesWide = 1 'ページ数を横１枚に .FitToPagesTall = 1 'ページ数を縦１枚に End With ActiveWindow.SelectedSheets.PrintPreview '印刷プレビュー表示 End Sub Sub ★値貼り付け() 'ショートカット割当：Ctrl＋e Selection.PasteSpecial xlPasteValues '形式を選択して貼り付け－値で貼付 End Sub Sub ★書式貼り付け() 'ショートカット割当：Ctrl＋t Selection.PasteSpecial xlPasteFormats '形式を選択して貼り付け－書式で貼付 End Sub Sub ★数式貼り付け() 'ショートカット割当：Ctrl＋q Selection.PasteSpecial xlPasteFormulas '形式を選択して貼り付け－数式で貼付 End Sub Sub ★行列を入れ替えて値貼り付け() 'ショートカット割当：Ctrl＋Shift＋V Selection.PasteSpecial xlPasteValues, _ Transpose:=True '形式を選択して貼り付け－値で貼付 '行と列を入れ替える End Sub Sub ★コピー後右の列に値で貼付() 'ショートカット割当：Ctrl＋Shift＋A Selection.Copy ActiveCell.Offset(0, 1).PasteSpecial xlPasteValues 'アクティブセルの1セル右側に貼付 '形式を選択して貼り付け－値で貼付 Application.CutCopyMode = False 'コピーのクリップボード解除 End Sub

sample/sheet-1

2011-08-02T11:36:18+09:00

Sub ★シートを新規ファイルにコピー() ActiveSheet.Copy Application.Dialogs(xlDialogSaveAs).Show arg1:=Range("D2").Value End Sub Sub ★全シートのカーソルをA1セルに移動() Dim 対象シート As Variant '定義：対象シート（Variant型） Dim i As Integer '定義：i （Integer型） i = 1 For Each 対象シート In Worksheets '全てのシートで動作 If Sheets(対象シート.Name).Visible = True Then '表示されているワークシートなら Sheets(対象シート.Name).Select Range("A1").Select 'カーソルをA1セルに移動 End If Next Do Until Sheets(i).Visible = True '表示されているシートになるまでLoopする i = i + 1 Loop Sheets(i).Select 'i番目のシートに移動 End Sub Sub ★列幅を合わせる() ActiveCell.Select Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End Sub Sub ★変更を保存して閉じる() 'ショートカット割当：Ctrl＋Shift＋S ActiveWorkbook.Close True End Sub Sub ★一定範囲コピペ値貼付後範囲外データ消去() 'ショートカット割当：Ctrl＋Shift＋V With ActiveSheet .Range("A:H").Copy .Range("A:H").PasteSpecial xlPasteValues .Range("I:N").DELETE .Range("A1").Select End With End Sub Sub ★全シート表示() Dim 対象シート As Variant '対象シートの定義（Variant型） For Each 対象シート In Worksheets '全てのシートで動作 Sheets(対象シート.Name).Visible = True 'ワークシートを表示する Next 　 Sheets(1).Select '１番左のシートに移動 End Sub Sub ★★左側のシート全削除() Dim n As Variant 　 Application.DisplayAlerts = False 　 With ActiveWorkbook n = .Worksheets.Count 　 For i = 1 To n - 1 .Worksheets(1).DELETE Next End With Application.DisplayAlerts = True 　 End Sub

sample/btob-1

2011-08-02T10:57:10+09:00

Option Explicit Sub 数値代入(カテゴリ As Variant, フラグ As Variant, 範囲 As Variant, 対象列 As Integer) Dim i As Integer, j As Integer, k As Integer, sRange As Range, sName As String '該当月に関数代入（PJPLをSUMIFする） Workbooks(カテゴリ).Activate If フラグ = 1 Then j = 7 Else j = 3 End If '「○」から「●」までのシートで関数代入～値化～合計関数戻し For i = j To Worksheets.Count - 1 Worksheets(i).Activate With Worksheets(i) '※$ZZ$8は十分値により修正の可能性有 .Cells(4, 対象列).Formula = "=SUMIF(" & 範囲 & "!$C$6:$ZZ$6,$B$2," & 範囲 & "!$C8:$ZZ8)" .Cells(4, 対象列).Copy .Range(Cells(4, 対象列), Cells(108, 対象列)).PasteSpecial Paste:=xlFormulas .Range(Cells(4, 対象列), Cells(108, 対象列)).Copy .Range(Cells(4, 対象列), Cells(108, 対象列)).PasteSpecial Paste:=xlValues End With For k = 1 To 105 Select Case k Case 12, 16, 29, 49, 53, 54, 55, 62, 67, 80, 81, 86, 89, 92, 93, 96, 100, 101, 105 Cells(k + 3, 対象列).Select Selection.FillRight End Select Next 'カーソルをA1セルに移動 Range("A1").Select Next Worksheets.Add(Before:=Worksheets(1)).Name = "temp" For i = j + 1 To Worksheets.Count - 1 Cells(i, 1) = Worksheets(i).Name Next Set sRange = Cells(j + 1, 1).CurrentRegion With ActiveSheet.Sort .SortFields.Clear .SortFields.Add Key:=Cells(j + 1, 1), SortOn:=xlSortOnValues, Order:=xlAscending .SetRange sRange .Apply End With For i = 1 To sRange.Rows.Count sName = Worksheets("temp").Cells(i + j, 1) Worksheets(sName).Move after:=Worksheets(i + j - 1) Next Application.DisplayAlerts = False Worksheets("temp").Delete Application.DisplayAlerts = True End Sub Sub グループ判定(GP As String, FILE As String, AM1部 As String, AM2部 As String, MM室 As String, IMS合計 As String) If GP = "ｱｶｳﾝﾄﾏﾈｼﾞﾒﾝﾄ1部" Then FILE = AM1部 ElseIf GP = "ｱｶｳﾝﾄﾏﾈｼﾞﾒﾝﾄ2部" Then FLE = AM2部 ElseIf GP = "ﾒﾃﾞｨｱﾏｰｹﾃｨﾝｸﾞ室" Then FILE = MM室 Else FILE = IMS合計 End If End Sub Sub BtoB_PJPL作成マクロ() 'エラーの際は「エラー処理」へ On Error GoTo エラー処理 '変数定義 Dim SHEET_元帳 As Variant, SHEET_ピボット As Variant, SHEET_PJ列別PL As Variant Dim SHEET_存在判定 As Variant, SHEET_追記用PL As Variant, SHEET_ST管理表 As Variant Dim FILE_AM1部 As Variant, FILE_AM2部 As Variant, FILE_MM室 As Variant, FILE_IMS合計 As Variant, FILE_MACRO As Variant Dim ARRAY_追記ラベル As Variant Dim RANGE_ピボット As Variant, RANGE_ST管理表 As Variant, PATH_PJ列別PL_外部用 As Variant, PATH_データ格納 As Variant Dim COUNT_PJ As Variant, COUNT_行 As Variant, COLUMN_ST管理表 As Variant Dim COUNT_NEWPJ As Variant, SHEET_NEWPJPL As Variant, START_NEWPJ As Variant, END_NEWPJ As Variant Dim i As Variant, j As Variant, COLUMN_MONTH As Integer Dim xPCach As PivotCache, xPTbl As PivotTable Dim BEFORE_GP As String, AFTER_GP As String, JUDGE_GP As String Dim BEFORE_FILE As String, AFTER_FILE As String, FILE As String '名称代入 SHEET_元帳 = "元帳" SHEET_ピボット = "ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ" SHEET_PJ列別PL = "PJPL" SHEET_存在判定 = "存在シート判定" SHEET_追記用PL = "追記用PL" SHEET_ST管理表 = Worksheets(Worksheets.Count).Name FILE_AM1部 = "ｱｶｳﾝﾄﾏﾈｼﾞﾒﾝﾄ1部.xlsx" FILE_AM2部 = "ｱｶｳﾝﾄﾏﾈｼﾞﾒﾝﾄ2部.xlsx" FILE_MM室 = "ﾒﾃﾞｨｱﾏｰｹﾃｨﾝｸﾞ室.xlsx" FILE_IMS合計 = "IMS事業部(BtoB)合計.xlsx" FILE_MACRO = ActiveWorkbook.Name ARRAY_追記ラベル = Array("事業部ｺｰﾄﾞ", "事業部", "部室ｺｰﾄﾞ", "部室名", "ｸﾞﾙｰﾌﾟｺｰﾄﾞ", "ｸﾞﾙｰﾌﾟ名") PATH_データ格納 = ActiveWorkbook.Path PATH_PJ列別PL_外部用 = "[" & FILE_MACRO & "]" & SHEET_PJ列別PL '変数の値代入 COUNT_行 = Worksheets(SHEET_元帳).Range("A1").End(xlDown).Row '※$AG$2000は十分値により修正の可能性有 RANGE_ST管理表 = "'" & SHEET_ST管理表 & "'!$A$12:$AG$2000" COLUMN_MONTH = Range("L3").Value COLUMN_ST管理表 = Range("I4").Value '各種ファイルオープン（AM1・AM2・MM・合計）⇒マクロシートに戻す Workbooks.Open PATH_データ格納 & "\" & FILE_AM1部 Workbooks.Open PATH_データ格納 & "\" & FILE_AM2部 Workbooks.Open PATH_データ格納 & "\" & FILE_MM室 Workbooks.Open PATH_データ格納 & "\" & FILE_IMS合計 Workbooks(FILE_MACRO).Activate '//--元帳操作 With Worksheets(SHEET_元帳) .Activate .Range("Q1").Value = ARRAY_追記ラベル(0) .Range("R1").Value = ARRAY_追記ラベル(1) .Range("S1").Value = ARRAY_追記ラベル(2) .Range("T1").Value = ARRAY_追記ラベル(3) .Range("U1").Value = ARRAY_追記ラベル(4) .Range("V1").Value = ARRAY_追記ラベル(5) .Range("Q2").Formula = "=VLOOKUP($K2," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & "-5,0)" .Range("R2").Formula = "=VLOOKUP($K2," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & "-4,0)" .Range("S2").Formula = "=VLOOKUP($K2," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & "-3,0)" .Range("T2").Formula = "=VLOOKUP($K2," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & "-2,0)" .Range("U2").Formula = "=VLOOKUP($K2," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & "-1,0)" .Range("V2").Formula = "=VLOOKUP($K2," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & ",0)" .Range("Q2:V2").Copy .Paste Range(.Range("Q2"), .Cells(COUNT_行, 17)) End With Set RANGE_ピボット = Worksheets(SHEET_元帳).Range("A1", Cells(COUNT_行, "V")) '範囲設定 Worksheets.Add Before:=Worksheets(SHEET_元帳) ActiveSheet.Name = SHEET_ピボット '//--ピボットテーブル作成 '①ピボットキャッシュ作成 Set xPCach = ActiveWorkbook.PivotCaches.Create _ (SourceType:=xlDatabase, SourceData:=RANGE_ピボット) '②ピボットキャッシュを元にピボットテーブルを作成 Set xPTbl = xPCach.CreatePivotTable _ (TableDestination:=Range("A3"), TableName:="Pivot1") '③ピボットテーブルの行・列・値などにフィールドを配置 With ActiveSheet.PivotTables("Pivot1") '行フィールド設定 .AddFields RowFields:=Array("PL番号", "PL科目") '列フィールド設定 With .PivotFields("プロジェクトコード") .Orientation = xlColumnField .Position = 1 End With With .PivotFields("プロジェクト名称") .Orientation = xlColumnField .Position = 2 End With 'データフィールド設定 With .PivotFields("金額") .Orientation = xlDataField .Function = xlSum .NumberFormat = "#,##0_ " End With '集計行非表示 .PivotFields("PL番号").Subtotals(1) = False .PivotFields("プロジェクトコード").Subtotals(1) = False .InGridDropZones = True .RowAxisLayout xlTabularRow End With ActiveSheet.Range("C6").Select ActiveWindow.FreezePanes = True '//--PJPLシート追加～PJコードペースト Worksheets.Add Before:=Worksheets(SHEET_ピボット) ActiveSheet.Name = SHEET_PJ列別PL Worksheets(1).Activate ActiveSheet.Range("B8", "D117").Copy ActiveSheet.Paste Worksheets(SHEET_PJ列別PL).Range("A3") Worksheets(SHEET_PJ列別PL).Range("A:B").Columns.AutoFit With Worksheets(SHEET_ピボット) .Activate COUNT_PJ = .Range("A5").End(xlToRight).Column .Range("C4", Cells(5, COUNT_PJ)).Copy .Paste Worksheets(SHEET_PJ列別PL).Range("C6") .Range("C8").Select ' Worksheets(SHEET_ピボット).Activate ' COUNT_PJ = ActiveSheet.Range("A5").End(xlToRight).Column ' ActiveSheet.Range("C4", Cells(5, COUNT_PJ)).Copy ' ActiveSheet.Paste Worksheets(SHEET_PJ列別PL).Range("C6") End With ActiveWindow.FreezePanes = True ActiveWindow.Zoom = 85 '//--関数代入～PJPL全体の完成（関数のまま）※Case文使う方がわかりやすい With Worksheets(SHEET_PJ列別PL) '※$ZZ$50は十分値により修正の可能性有 .Activate .Range("C8").Formula = "=IF(ISERROR(MATCH($A8,ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ!$A$6:$A$100,0)),0,INDEX(ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ!$C$6:$ZZ$100,MATCH($A8,ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ!$A$6:$A$100,0),MATCH(C$6,ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ!$C$4:$ZZ$4,0)))" .Range("C8").Copy For i = 1 To 105 Select Case i Case 12, 16, 29, 49, 53, 54, 55, 62, 67, 80, 81, 86, 89, 92, 93, 96, 100, 101, 105 Case Else .Paste Cells(i + 7, "C") End Select Next .Range("C8", "C112").Copy .Paste Range(.Range("C8"), .Cells(112, COUNT_PJ)) End With '//--存在シート判定 '※6月作成後、起点セル変更H3⇒I3 2011/7/14 Worksheets(SHEET_ピボット).Activate COUNT_PJ = ActiveSheet.Range("A5").End(xlToRight).Column ActiveSheet.Range("C4", Cells(5, COUNT_PJ)).Copy With Worksheets(SHEET_存在判定) .Activate .Range("I3").PasteSpecial Paste:=xlValues, Transpose:=True COUNT_PJ = .Range("I3").End(xlDown).Row START_NEWPJ = .Range("B3").End(xlDown).Row + 1 END_NEWPJ = START_NEWPJ '※$B$1000は十分値により修正の可能性有 .Range("K3").Formula = "=IF(ISERROR(VLOOKUP($I3,$B$3:$B$1000,1,0)),""NG"",""OK"")" .Range("K3").Copy .Paste Range(.Range("K3"), .Cells(COUNT_PJ, "K")) For i = 3 To COUNT_PJ If .Cells(i, "K").Value = "NG" Then COUNT_NEWPJ = .Range("B3").End(xlDown).Row + 1 .Range(.Cells(i, "I"), .Cells(i, "J")).Copy .Cells(COUNT_NEWPJ, "B").PasteSpecial Paste:=xlValues .Cells(COUNT_NEWPJ, "D").Formula = "=SUBSTITUTE(LEFTB(CONCATENATE(IF(B" & COUNT_NEWPJ & ">=1000,B" & COUNT_NEWPJ & ",0&B" & COUNT_NEWPJ & "),C" & COUNT_NEWPJ & "),30),""/"","" "")" .Cells(COUNT_NEWPJ, "E").Formula = "=VLOOKUP($B" & COUNT_NEWPJ & "," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & ",0)" END_NEWPJ = END_NEWPJ + 1 End If Next .Range("F3").Formula = "=VLOOKUP($B3," & RANGE_ST管理表 & "," & COLUMN_ST管理表 & ",0)" .Range("G3").Formula = "=IF($E3=$F3,""OK"",""NG"")" .Range("F3", "G3").Copy .Paste Range(.Range("F3"), .Cells(END_NEWPJ - 1, "F")) End With '//--新規PJのPLシート追加 'テスト用 ' START_NEWPJ = 225 ' END_NEWPJ = 226 '新規PJPLに関する情報を追記用PLに代入 For j = START_NEWPJ To END_NEWPJ - 1 With Worksheets(SHEET_追記用PL) .Range("B2") = Worksheets(SHEET_存在判定).Cells(j, "B").Value .Range("E2") = Worksheets(SHEET_存在判定).Cells(j, "C").Value SHEET_NEWPJPL = Worksheets(SHEET_存在判定).Cells(j, "D").Value JUDGE_GP = Worksheets(SHEET_存在判定).Cells(j, "E").Value 'グループ判定グループ判定 JUDGE_GP, FILE, FILE_AM1部, FILE_AM2部, FILE_MM室, FILE_IMS合計 If JUDGE_GP = "ｱｶｳﾝﾄﾏﾈｼﾞﾒﾝﾄ1部" Then FILE_追記 = FILE_AM1部 ElseIf JUDGE_GP = "ｱｶｳﾝﾄﾏﾈｼﾞﾒﾝﾄ2部" Then FILE_追記 = FILE_AM2部 ElseIf JUDGE_GP = "ﾒﾃﾞｨｱﾏｰｹﾃｨﾝｸﾞ室" Then FILE_追記 = FILE_MM室 Else FILE_追記 = FILE_IMS合計 End If '新規PJPL追加 .Copy Before:=Workbooks(FILE_追記).Worksheets("●") End With 'シート名を変更して、マクロシートに戻る ActiveSheet.Name = SHEET_NEWPJPL Workbooks(FILE_MACRO).Activate Next 'PJの部門が変更になったシートを移動させる With Worksheets(SHEET_存在判定) For j = 3 To START_NEWPJ - 1 If Cells(j, "G") = "NG" Then BEFORE_GP = .Cells(j, "E").Value AFTER_GP = .Cells(j, "F").Value グループ判定 BEFORE_GP, BEFORE_FILE, FILE_AM1部, FILE_AM2部, FILE_MM室, FILE_IMS合計グループ判定 AFTER_GP, AFTER_FILE, FILE_AM1部, FILE_AM2部, FILE_MM室, FILE_IMS合計 'BEFOREファイル呼び出し '該当シート捜索 'AFTERシートに移動 '//--各データで数値代入※合計データのみフラグ「1」を立てる数値代入 FILE_AM1部, 0, PATH_PJ列別PL_外部用, COLUMN_MONTH 数値代入 FILE_AM2部, 0, PATH_PJ列別PL_外部用, COLUMN_MONTH 数値代入 FILE_MM室, 0, PATH_PJ列別PL_外部用, COLUMN_MONTH 数値代入 FILE_IMS合計, 1, PATH_PJ列別PL_外部用, COLUMN_MONTH '//--IMS合計の総計PL金額とマクロのPJ列別PLの各行合計と一致するか確認する With Workbooks(FILE_MACRO).Worksheets(SHEET_PJ列別PL) .Activate COUNT_PJ = .Range("A7").End(xlToRight).Column .Cells(7, COUNT_PJ + 1).Value = "PJ合計" .Cells(7, COUNT_PJ + 2).Value = "IMS合計PLより" .Cells(7, COUNT_PJ + 3).Value = "差異" .Cells(8, COUNT_PJ + 1).Formula = "=SUM(C8：" & Cells(8, COUNT_PJ).Address(0, 0) & ")" .Cells(8, COUNT_PJ + 3).Formula = "=" & Cells(8, COUNT_PJ + 2).Address(0, 0) & "-" & Cells(8, COUNT_PJ + 1).Address(0, 0) .Range(Cells(8, COUNT_PJ + 1), Cells(8, COUNT_PJ + 3)).Copy .Paste Range(Cells(8, COUNT_PJ + 1), Cells(112, COUNT_PJ + 1)) End With Workbooks(FILE_IMS合計).Worksheets(1).Activate Range(Cells(4, COLUMN_MONTH), Cells(108, COLUMN_MONTH)).Copy Workbooks(FILE_MACRO).Worksheets(SHEET_PJ列別PL).Activate ActiveSheet.Cells(8, COUNT_PJ + 2).PasteSpecial Paste:=xlValues Exit Sub 'エラー発生時の処理エラー処理: MsgBox Err.Number & ":" & Err.Description End Sub

メニュー

2011-07-14T09:46:55+09:00

**メニュー -[[トップページ]] -[[プラグイン紹介>プラグイン]] -[[まとめサイト作成支援ツール]] -[[メニュー]] -[[メニュー2]] ---- **リンク -[[@wiki>>http://atwiki.jp]] -[[@wikiご利用ガイド>>http://atwiki.jp/guide/]] **他のサービス -[[無料ホームページ作成>>http://atpages.jp]] -[[無料ブログ作成>>http://atword.jp]] -[[2ch型掲示板レンタル>>http://atchs.jp]] -[[無料掲示板レンタル>>http://atbbs.jp]] -[[お絵かきレンタル>>http://atpaint.jp/]] -[[無料ソーシャルプロフ>>http://sns.atfb.jp/]] // リンクを張るには "[" 2つで文字列を括ります。 // ">" の左側に文字、右側にURLを記述するとリンクになります合計：&counter() 今日：&counter(today) 昨日：&counter(yesterday) トップページの合計：&counter(total, page=トップページ) //**更新履歴 //#recent(20) &link_editmenu(text=ここを編集)

プラグイン/動画(Youtube)

2011-07-14T09:41:41+09:00

* 動画(youtube) @wikiのwikiモードでは #video(動画のURL) と入力することで、動画を貼り付けることが出来ます。詳しくはこちらをご覧ください。＝＞http://atwiki.jp/guide/17_209_ja.html また動画のURLはYoutubeのURLをご利用ください。＝＞http://www.youtube.com/ ----- たとえば、#video(http://youtube.com/watch?v=kTV1CcS53JQ)と入力すると以下のように表示されます。 #video(http://youtube.com/watch?v=kTV1CcS53JQ)

プラグイン

2011-07-14T09:41:41+09:00

@wikiにはいくつかの便利なプラグインがあります。 ----- #ls ----- これ以外のプラグインについては@wikiガイドをご覧ください =>http://atwiki.jp/guide/

プラグイン/関連ブログ

2011-07-14T09:41:41+09:00

* 関連ブログ @wikiのwikiモードでは #bf(興味のある単語) と入力することで、あるキーワードに関連するブログ一覧を表示することができます詳しくはこちらをご覧ください。＝＞http://atwiki.jp/guide/17_161_ja.html ----- たとえば、#bf(ゲーム)と入力すると以下のように表示されます。 #bf(ゲーム)