Results of 1 - 1 of about 8930 for リスト (0.007 sec.)
- [[20150904103428]]
- #score: 2746
- @digest: 0edfe672ce430bd4a2fdb4011a365c9b
- @id: 68835
- @mdate: 2015-09-04T04:28:27Z
- @size: 11790
- @type: text/plain
- #keywords: 覧リ (90165), ー], (52054), ト[@ (42644), setcnt (37733), 振伝 (32444), listobjects (27854), newkey (26829), critem1 (21970), critem2 (21365), copyfrom (19867), cramt2 (18074), 伝") (17684), cramt1 (17497), databodyrange (14436), ト[ (14098), pos (9052), 一覧 (6368), formatconditions (5866), 事業 (3955), xlsortonvalues (3951), sortfields (3784), sh1 (3656), mydate (3565), ト") (3327), リス (3191), 表") (3071), 業所 (2875), enableevents (2791), ブロ (2669), worksheetfunction (2574), range (2303), columns (2211)
- 『文字の色』（くろ）
いつもお世話になってます。 以前教えてもらって作ったものなのですが [[20150715132756]]『データを横から縦にした時の転記 No2』（くろ） [[20150711095654]]『データを横から縦にした時の転記』（くろ） 一覧表シート E列 振伝シート L:M列（結合） に「〜事業所」「〜支店」があれば文字を赤になるように教えてもらったのですが、 追加で「〜部」をしたのですがどの部分を変更すれば良いのか分かりません。 宜しくお願いします。 ＜ 使用 Excel:Excel2010、使用 OS:Windows8 ＞ ---- もう、すっかり忘却のかなたです。そちらの最終形のコードがどうなっているかわかりませんが With .Range("L1:L12") .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=COUNTIF(" & .Cells(1).Address(False, False) & ",""*事業所"")" With .FormatConditions(1).Font .Color = 255 End With .FormatConditions.Add Type:=xlExpression, Formula1:= _ "=COUNTIF(" & .Cells(1).Address(False, False) & ",""*支店"")" With .FormatConditions(2).Font .Color = 255 End With End With こんなところがありますね。事業所と支店に色を付けているところです。 ここに 部 を、同じような要領で（ただし、.FormatConditions(3).Font) コードを追加すればいかがですか? （β） 2015/09/04(金) 12:12 ---- ↑ あっ!! このコードは【一回こっきり】内のコードでしたね。 一回こっきりは、通常の運用で使うものではなく、最初に、手作業で、関連ブックの関連シートの数式、書式、テーブル などを設定するかわりに 「サービス」として提供したもので、しかも、そのあとの要件改訂に、すべて対応しているわけではありません。 最終的には、「もう一回こっきりの使用はやめましょう」ということになっていたと記憶。 今、一回こっきりに、このコードを追加して実行したとして、ほかの部分が、現在の仕様にあわずに 障害発生のもとになる可能性があります。 ここは、テーブルのデータ部分（タイトル行を除いた部分）を選択して、そこに対して、この条件付き書式を 手作業で設定されたほうがいいですよ。 （β） 2015/09/04(金) 13:24 ---- （β）さん 早速回答ありがとうございます。 このような式を探したのですが、どこに書いてあるのでしょうか? 以下全式です。 【一覧表シート】 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim st As Long Dim cnt As Long If Intersect(Target, ListObjects(1).DataBodyRange) Is Nothing Then Exit Sub If Intersect(Target, Range("A:B")) Is Nothing Then Exit Sub Cancel = True Application.EnableEvents = False Application.ScreenUpdating = False Select Case Target.Column Case 1 '選択された行のみの振伝作成(個別) st = WorksheetFunction.Match(Target.EntireRow.Range("M1"), Columns("M"), 0) cnt = WorksheetFunction.CountIf(ListObjects(1).DataBodyRange.Columns("M"), Target.EntireRow.Range("M1")) make振伝 st, cnt ReForm一覧 Worksheets("振伝").Select Case 2 '選択された日付をもつデータの振伝作成(全て) ReForm一覧 st = WorksheetFunction.Match(Target.EntireRow.Range("B1"), Columns("B"), 0) cnt = WorksheetFunction.CountIf(ListObjects(1).DataBodyRange.Columns("B"), Target) make振伝 st, cnt 保存 End Select Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Range Dim c As Range Dim i As Long '入力あった列幅調整のみ Set r = Intersect(Target, ListObjects(1).DataBodyRange) If r Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In r.Rows '列幅自動調整 c.EntireColumn.AutoFit c.Offset(-1, 0).EntireRow.Range("H1").Formula = "=IF(一覧リスト[@キー]<>M" & c.Row & ",SUMIF(一覧リスト[キー],一覧リスト[@キー],一覧リスト[金額])-SUMIF(一覧リスト[キー],一覧リスト[@キー],一覧リスト[合計2]),"""")" Next 'キー列を非表示 Columns("M").Hidden = True Application.EnableEvents = True End Sub 【標準モジュール 1】 Option Explicit Sub make振伝(st As Long, cnt As Long) Dim pos As Range Dim sh1 As Worksheet Dim sh2 As Worksheet Dim oldKey As String Dim newKey As String Dim i As Long Dim j As Long Dim num As Long Dim copyFrom As Range Dim setcnt As Long Dim crItem1 As String Dim CrAmt1 As String Dim crItem2 As String Dim CrAmt2 As Long Dim DrItem As String Dim DrRmk As String Dim DrAmt As Long Dim dt As Date Dim n As Long Set sh1 = Sheets("一覧表") Set sh2 = Sheets("振伝") With sh2.Range("A1", sh2.UsedRange) If .Rows.Count > 14 Then .Offset(14).EntireRow.Delete End If End With Set copyFrom = sh2.Rows("1:14") '各行の取り出し For i = st To st + cnt - 1 newKey = sh1.Rows(i).Range("M1") If oldKey <> newKey Then If pos Is Nothing Then '最初 Set pos = sh2.Range("A1") Else Set pos = pos.Offset(14) '次のブロック位置 copyFrom.Copy pos Application.CutCopyMode = False End If 'ブロックの初期化 pos.Range("B6:I12").ClearContents pos.Range("K6:K12").ClearContents pos.Range("L6:M12").ClearContents setcnt = 0 num = 1 '貸方項目、ヘッダー項目 dt = sh1.Rows(i).Range("B1").Value n = WorksheetFunction.CountIf(sh1.ListObjects(1).DataBodyRange.Columns("M"), newKey) If n > 1 Then crItem1 = Join(WorksheetFunction.Transpose(sh1.Rows(i).Range("G1").Resize(n).Value), "") crItem2 = Join(WorksheetFunction.Transpose(sh1.Rows(i).Range("I1").Resize(n).Value), "") CrAmt1 = WorksheetFunction.SumIf(sh1.Rows(i).Range("M1").Resize(n), newKey, sh1.Rows(i).Range("H1").Resize(n)) CrAmt2 = WorksheetFunction.SumIf(sh1.Rows(i).Range("M1").Resize(n), newKey, sh1.Rows(i).Range("J1").Resize(n)) Else crItem1 = sh1.Rows(i).Range("G1").Value crItem2 = sh1.Rows(i).Range("I1").Value CrAmt1 = sh1.Rows(i).Range("H1").Value CrAmt2 = sh1.Rows(i).Range("J1").Value End If pos.Range("N6").Value = crItem1 pos.Range("S6").Value = CrAmt1 pos.Range("N7").Value = crItem2 pos.Range("S7").Value = CrAmt2 End If 'ヘッダー項目のセット pos.Range("M2").Value = num pos.Range("B4").Value = dt pos.Range("N13").Value = sh1.Rows(i).Range("C1").Value '借方項目のセット DrRmk = sh1.Rows(i).Range("E1").Value DrItem = sh1.Rows(i).Range("D1").Value DrAmt = sh1.Rows(i).Range("F1").Value If setcnt >= 7 Then '7項目セット済みならブロックを追加 copyFrom.Copy pos.Offset(14) Application.CutCopyMode = False Set pos = pos.Offset(14) num = num + 1 'ブロックの初期化 pos.Range("M2").Value = num pos.Range("B4").Value = dt pos.Range("N13").Value = sh1.Rows(i).Range("C1").Value pos.Range("B6:I12").ClearContents pos.Range("K6:K12").ClearContents pos.Range("L6:M12").ClearContents pos.Range("N6").Value = Empty pos.Range("N7").Value = Empty pos.Range("S6").Value = Empty pos.Range("S7").Value = Empty setcnt = 0 End If setcnt = setcnt + 1 pos.Range("B6").Offset(setcnt - 1).Value = DrAmt pos.Range("K6").Offset(setcnt - 1).Value = DrItem pos.Range("L6").Offset(setcnt - 1).Value = DrRmk oldKey = newKey Next End Sub Sub 保存() Dim FileName As String Dim myDate As Date Sheets("振伝").Copy FileName = ThisWorkbook.Path & "¥" & Month(myDate) & "月" & ".xlsx" With ActiveWorkbook myDate = .Sheets(1).Range("B4") FileName = ThisWorkbook.Path & "¥" & Month(myDate) & "月" & ".xlsx" .Sheets(1).Name = Month(myDate) & "月" Application.DisplayAlerts = False '同名ブックあれば無条件上書き .SaveAs FileName Application.DisplayAlerts = True End With End Sub Sub ReForm一覧() Dim r As Range Dim c As Range Dim x As Long With Sheets("一覧表") '並び替え .ListObjects("一覧リスト").Sort.SortFields.Clear .ListObjects("一覧リスト").Sort.SortFields.Add Key:=Range("一覧リスト[日付]"), SortOn:=xlSortOnValues, Order:=xlAscending .ListObjects("一覧リスト").Sort.SortFields.Add Key:=Range("一覧リスト[振伝順番]"), SortOn:=xlSortOnValues, Order:=xlAscending .ListObjects("一覧リスト").Sort.SortFields.Add Key:=Range("一覧リスト[事業所]"), SortOn:=xlSortOnValues, Order:=xlAscending With .ListObjects("一覧リスト").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'A列連番振り直し .Range("A2").Value = 1 Range("一覧リスト[連番]").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False End With End Sub 【標準モジュール 2】 Option Explicit Sub テーブル再設定() Dim fm As String Dim tmp As Variant Application.EnableEvents = False fm = "=IF(一覧リスト[@キー]<>M3,SUMIF(一覧リスト[キー],一覧リスト[@キー],一覧リスト[金額])-SUMIF(一覧リスト[キー],一覧リスト[@キー],一覧リスト[合計2]),"""")" With Sheets("一覧表") On Error Resume Next .ListObjects(1).Unlist On Error GoTo 0 .Cells.Interior.ColorIndex = xlNone .Cells.Borders.LineStyle = xlNone With .UsedRange .Columns("K").Offset(1).Resize(.Rows.Count - 1).Formula = "=IFERROR(VLOOKUP(C2,名前リスト,2,FALSE),"""")" .Columns("M").Cells(1).Value = "キー" .Columns("M").Offset(1).Resize(.Rows.Count - 1).Formula = "=TEXT(B2,""yymmdd"")&C2&IF(L2="""","" "",L2)" '以下は念のため With .Columns("J").Offset(1).Resize(.Rows.Count - 1) tmp = .Value .ClearContents .Value = tmp End With End With With .ListObjects.Add(xlSrcRange, .UsedRange, , xlYes) .Name = "一覧リスト" .TableStyle = "TableStyleLight15" End With With .UsedRange .Columns("H").Offset(1).Resize(.Rows.Count - 1).Value = fm End With 'キー列を非表示 .Columns("M").Hidden = True End With Application.EnableEvents = True End Sub 【ThisWorkbook】 Option Explicit Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Application.EnableEvents = False With Sheets("一覧表") 'テーブルの下のB列セルを選択 Application.GoTo .Cells(.ListObjects("一覧リスト").ListRows.Count + 2, "B") End With Application.EnableEvents = True End Sub （くろ） 2015/09/04(金) 13:26 ---- （β） さん 条件書式ですね。やってみます。 ありがとうございます。 （くろ） 2015/09/04(金) 13:28... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201509/20150904103428.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97045 documents and 608216 words.
訪問者：