ウォーターサーバーとコーヒーマシンが一体化した画期的マシン >>

自分はあまり、VBAができないので、ネットで検索したのですがうまく利用できそうなものがありませんでした。以下について、教えてください。
よろしくお願いいたします。

対象のブックには、aシートからfシートまで、6つのシートがあります。
そのうち、bからdまでの3つのシートについて、以下の条件で集約したいです。

⓵項目名はbシートの1行目のA列からF列までを使う
②bからdまでの3つのシートの2行目以降をデータがあるところまで、コピーして一つのシートに集約
③集約後、B列に”削除”と入力されている行は削除する

A 回答 (4件)

No.3の物です。

一ヶ所訂正を。
Do while loop内の
i = i + 1は、end if の後ろではなく、elseとend ifの間に入れてください。
訂正しないと、"削除"が2行続いた場合に行の削除漏れか出てしまいます。すみませんでした。
    • good
    • 0

・b~cのデータはA~F列が共通のデータであり、途中(特にA列)に空白はない


・他にシートは存在しない(集約シートを作るところからのマクロです。)

という前提で、以下のプロシージャはいかがでしょう。

Sub 集約()
Application.ScreenUpdating = False

Dim tsheet As Worksheet, i As Long, trc As Long
Dim narray(1 To 3) As Variant
Set tsheet = Sheets.Add(after:=Sheets(Sheets.Count))    '新しく作成する「集約シート」
tsheet.Name = "b~c集約"
narray(1) = "b"
narray(2) = "c"
narray(3) = "d"

For i = 1 To 3
If i = 1 Then
Sheets(narray(i)).Range("A1").CurrentRegion.Copy _
Destination:=tsheet.Range("A1")
Application.CutCopyMode = False
Else
trc = tsheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Sheets(narray(i)).Range("A1").CurrentRegion.Offset(1, 0).Copy _
Destination:=tsheet.Cells(trc, 1)
Application.CutCopyMode = False
End If
Next i

With tsheet
i = 2
Do While .Cells(i, 1) <> ""
If .Cells(i, 2) = "削除" Then
.Rows(i).Delete
Else
End If
i = i + 1
Loop
End With

Application.ScreenUpdating = True
End Sub

すでに集約シートがあり、新たな集約シートを作るときは、同一名のシートを2つ作成できないエクセルの仕様上エラー・デバッグ表示が出ます。On Errorで回避してもよいのですが、今回は入れませんでした。

gooの表示上ネストが入らないみたいですが、まあそこはご勘弁を。
    • good
    • 0

No.1です。



>集約シートを作って実行したのですが、集約のところでデバックになってしまいます。

a~f までの6シートがあり、
同じブック内に「集約」というシート名のシートを追加してマクロを実行したのですかね?

「集約」のところでエラーになる!というコトはそのシートが存在しない!という可能性が高いと思います。
入力間違いなどはないでしょうか?

それとも、もしかしてシートモジュールにしていませんか?
前回も記述したように必ず「標準モジュール」にする必要があります。
シートモジュールで別シートの操作(特にデータ消去など)を行うと
エラーになります。

こちらで考えられるといえばこのくらいしか思い浮かびません。m(_ _)m
    • good
    • 0

こんにちは!



>コピーして一つのシートに集約
とありますが、どのシートにまとめるのかが不明です。

とりあえず同じブック内に「集約」というシート名のシートが存在する!
という前提で・・・
色々やり方はあると思いますが、一例です。
標準モジュールにしてください。

Sub Sample1()
 Dim k As Long, lastRow As Long
 Dim wS As Worksheet, myAry
  myAry = Array("b", "c", "d")
   With Worksheets("集約")
    .Range("A:F").ClearContents
     .Range("A1:F1").Value = Worksheets("b").Range("A1:F1").Value
      For k = 0 To UBound(myAry)
       Set wS = Worksheets(myAry(k))
        lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
         Range(wS.Cells(2, "A"), wS.Cells(lastRow, "F")).Copy
         .Cells(Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
      Next k
     lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
      .Range("A1").AutoFilter field:=2, Criteria1:="削除"
       If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
        Range(.Cells(2, "A"), .Cells(lastRow, "F")).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
       End If
      .AutoFilterMode = False
      .Activate
      .Range("A1").Select
   End With
  MsgBox "完了"
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

遅くなり、申し訳ありません。
集約シートを作って実行したのですが、集約のところでデバックになってしまいます。

なぜでしょうか?

お礼日時:2019/02/18 18:13

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aと関連する良く見られている質問

QエクセルVBA ファイル移動について お詳しい方 ご教授をお願いします やりたいこと エクセルファイ

エクセルVBA ファイル移動について

お詳しい方 ご教授をお願いします

やりたいこと
エクセルファイルにて
下記のコードにて指定フォルダの指定した拡張子ごとセルC6からリスト化を行う
Sub ファイル取込_Click()

    Dim buf As String, cnt As Long

    Const Path As String = "C:\Sample\"

    buf = Dir(Path & "*.xlsx")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

    Loop

    buf = Dir(Path & "*.bmp")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

    Loop

  

    buf = Dir(Path & "*.jpg")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

    Loop

   

     buf = Dir(Path & "*.pdf")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

      Loop

   

     buf = Dir(Path & "*.pptx")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

       

         Loop

   

     buf = Dir(Path & "*.xlsm")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

       

            Loop

   

     buf = Dir(Path & "*.log")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

       

                  Loop

   

     buf = Dir(Path & "*.docx")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

                      Loop

   

     buf = Dir(Path & "*.zip")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

       Loop

End Sub

その後
C3,C4,C5のセル記載内容を元に名前を付け新規作成するコードを使用
'-----------------------------------------同名フォルダを探し無ければ作成を行う

Dim xFold As String, xPath As String

Range("A1").Activate

Const xParent As String = "C:\Users\PC\Documents\新しいフォルダ\" '保存フォルダ先

xFold = ActiveCell.Offset(2, 2).Value & ActiveCell.Offset(3, 2).Value & ActiveCell.Offset(3, 4).Value  'フォルダの名前設定

xPath = xParent & xFold

If Dir(xPath, vbDirectory) = vbNullString Then

MsgBox xParent & "に" & xFold & "フォルダを作成します。"

MkDir xPath

Else

MsgBox xPath & "は既にあります。"

Exit Sub

End If

困り事
ここまではいけたのですが、
自動で新規作成したフォルダにリスト化した同名ファイルを移動させるのがうまくいきません
フォルダ名を指定しての移動は簡単にできたのですが・・
アドバイスをお願いします

エクセルVBA ファイル移動について

お詳しい方 ご教授をお願いします

やりたいこと
エクセルファイルにて
下記のコードにて指定フォルダの指定した拡張子ごとセルC6からリスト化を行う
Sub ファイル取込_Click()

    Dim buf As String, cnt As Long

    Const Path As String = "C:\Sample\"

    buf = Dir(Path & "*.xlsx")

    Do While buf <> ""

 

        cnt = cnt + 1

        Cells(cnt + 5, 3) = buf

        buf = Dir()

    Loop

    buf = Dir(Path & "*.bmp")

    Do While buf <> ""...続きを読む

Aベストアンサー

何度も回答してしまい申し訳ありません。

多分以下でいけます!

Do While Cells(i, 3) <> ""
  buf = Cells(i, 3)
  Name Path & buf As xPath & "\" & buf
  'コピーする場合は
  'FileCopy Path & buf, xPath & "\" & buf
  i = i + 1
Loop

タイプミスとスラッシュ漏れと、結構初歩的なミスばかりですみません。
これでお願いします。

QCSVで文字化けしてしまうのを直すマクロ

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/file10.htm

例 空白→""、 神奈川→"神奈川"

やりたいこととしてはファイル名とあるシートのA列2行目に書いてあるCSVファイルを開き、文字化けを直してSheet1にデータを表示させ、それをファイル名が書いてある最終行まで行いたいです。

Sub macro()
Dim i1 As Long, x As Long
Rbook As Workbook
Rsheet As Worksheet, Ssheet As Worksheet
Set Rbook = ThisWorkbook

Sheets("ファイル名").Select
Set Rsheet = Rbook.Worksheets("ファイル名")
For i1 = 2 To 10
If Rsheet.Cells(i1, 1).Value <> "" Then
Sheets("SHEET1").Select ’表示させるシート
Set Ssheet = Rbook.Worksheets("SHEET1")
Ssheet.Cells.Clear
Ssheet.Range("A1").Select

’文字化けを直す
Dim buf As String, Target As String, i1 As Long
Dim tmp As Variant, j As Long
Target = "¥アドレス" & Ssheet.Cells(i, 1).Value
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile Target
Do Until .EOS
buf = .ReadText(-2)
i = i + 1
tmp = Split(buf, ",")
For j = 0 To UBound(tmp)
Cells(i, j + 1) = tmp(j)
Next j
Loop
.Close
End With

’別のマクロ実行

End if
Next i1

’2行目、3行目と続く

End Sub

どうぞよろしくお願い致します。

いつもお世話になっております。
Excel2013を使用していますので
アドバイスどうぞよろしくお願いします。

"ファイル名"というシートのA列2行目からCSVファイルのファイル名が書いてあります。
日によるのですが、だいたい5~10件程度です。
そしてこのCSVファイルがくせ者でファイルを開くと文字化けを起こしてしまいます。下記のサイトを参考にマクロを作ったのですが、文字化けはしないものの文字に必ず""がついてしまい、また一行しか転記されません。

http://officetanaka.net/excel/vba/file/fil...続きを読む

Aベストアンサー

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでしょうか。
End Sub '←ここが最後の行

それと、私は、参照設定で、Adodb を入れていること。(Microsoft ActiveX Data Objects 2.8 Library)
Dim Strm As ADODB.Stream

これらは、あまり関係ないけれども、実際に自分がする時はこうします。もちろん、ご質問者さんが選んだ方法を完動するように書き上げただけですから、この延長上に、同様のエラーがなくなるという可能性は低いのではないかと思います。

今、思いついたのは、Excel 関数のClean 関数を間に入れる方法はあるとは思います。
それは、エラーを起こすと予想されるバイナリコードを除去する働きがあります。ただし、エラーがバイナリコードであれば、という条件です。

しかし、こちら側では、根本的な解決策は見当たりません。が、何度もトライするよりも、ダメだったファイルが、どうしてだめだったか、エディターなどで調べていただいたほうが良いですね。そちらのほうが早いのです。
巨大なファイルではない限りは、文字変換で、UTF-8 から、SJISに変換するツールで、一旦変更してから、インポートするほうが楽だと思います。Vector で、Unix系のツールなどいくつかあるようです。

こんにちは。

>そのあと"buf = .ReadText(-2)"で止まり
>"パラメーターが間違っています"と表示されてしまいます。。。
>アドバイスどうぞよろしくお願いします。

ご指摘の部分は、残念ですが、想定外の問題で、ADODBを使って別のやり方はありますが、そのデータ自体の問題であり、原因は分からないままにコードを変えて何度も繰り返す可能性のほうが高いです。別のファイルでも、2番めに同じように起こりますか?

   Next j
  Loop
  .Close
 End With
 Set Strm = Nothing '←は入れたらどうでし...続きを読む

QExcelでフィルターを使わずに抽出するにはどうしたらよいのでしょうか

お世話になります。
画像のようにしたいです。
よろしくお願いいたします。

Aベストアンサー

こんな感じでしょうか(Excelっぽくないけど)。
ちなみに、最初の画像のレイアウトを想定して作っています。列の間隔はご自分で調整してください。

Sub sample()
Dim i As Long
Dim c As Long
Dim r As Long
c = 4
r = 2
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(r, c).Value = Cells(i, "A").Value
Cells(r, c + 1).Value = Cells(i, "B").Value
If Cells(i, "A").Value = Cells(i + 1, "A").Value Then
r = r + 1
Else
c = c + 2
r = 2
End If
Next i
End Sub

こんな感じでしょうか(Excelっぽくないけど)。
ちなみに、最初の画像のレイアウトを想定して作っています。列の間隔はご自分で調整してください。

Sub sample()
Dim i As Long
Dim c As Long
Dim r As Long
c = 4
r = 2
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(r, c).Value = Cells(i, "A").Value
Cells(r, c + 1).Value = Cells(i, "B").Value
If Cells(i, "A").Value = Cells(i + 1, "A").Value Then
r = r + 1
Else...続きを読む

Qエクセル 2016 VBA マクロ 別シートとの照合

Sheet2のA列、E列、G列、H列、I列、K列、M列と
Sheet1のA列、D列、F列、G列、H列、J列、L列を照合して
Sheet2のN列に"削除"と記載があればSheet1の該当行を削除
Sheet2のN列に"削除"以外の記載があれば
Sheet1のM列にSheet2のN列に記載されている文字を反映。

1行目はタイトル行。
最終行は共にA列で判断します。

以上のマクロを教えてください。
宜しくお願い致します。

Aベストアンサー

何度もごめんなさい。

まったく別の方法でやってみました。
配列を使わない方法なので少し時間を要するかもしれませんが、Sheet1が400行程度だというコトなので
そんなに手待ちになるコトはないと思います。

オーソドックスなやり方で、作業用の列を使ってみました。

Sub Sample3()
 Dim i As Long, j As Long
 Dim lastRow As Long, c As Range
 Dim myStr As String, wS As Worksheet, myAry
  Set wS = Worksheets("Sheet2")
   wS.Range("P:P").Insert
    myAry = Array(1, 5, 7, 8, 9, 11, 13)
     For i = 2 To wS.Cells(Rows.Count, "A").End(xlUp).Row
      With wS.Cells(i, "P")
       For j = 0 To UBound(myAry)
        .Value = .Value & wS.Cells(i, myAry(j)) & "_"
       Next j
      End With
     Next i
    With Worksheets("Sheet1")
     myAry = Array(1, 4, 6, 7, 8, 10, 12)
     lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
      For i = 2 To lastRow
       For j = 0 To UBound(myAry)
        myStr = myStr & .Cells(i, myAry(j)) & "_"
       Next j
       Set c = wS.Range("P:P").Find(what:=myStr, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
         .Cells(i, "M") = wS.Cells(c.Row, "N")
        End If
       myStr = ""
      Next i
     .Rows(1).AutoFilter field:=13, Criteria1:="削除"
      If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
       Range(.Cells(2, "A"), .Cells(lastRow, "M")).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
      End If
     .AutoFilterMode = False
    End With
     wS.Range("P:P").Delete
     MsgBox "完了"
End Sub

※ コードの最初と最後に
>Application.ScreenUpdating = False

> Application.ScreenUpdating = True
を付け加えると少しは時間短縮ができるかも・・・m(_ _)m

何度もごめんなさい。

まったく別の方法でやってみました。
配列を使わない方法なので少し時間を要するかもしれませんが、Sheet1が400行程度だというコトなので
そんなに手待ちになるコトはないと思います。

オーソドックスなやり方で、作業用の列を使ってみました。

Sub Sample3()
 Dim i As Long, j As Long
 Dim lastRow As Long, c As Range
 Dim myStr As String, wS As Worksheet, myAry
  Set wS = Worksheets("Sheet2")
   wS.Range("P:P").Insert
    myAry = Array(1, 5, 7, 8, 9, 11, 1...続きを読む

QエクエルのVBAについての質問です。 一つのフォルダにエクセルシートが100個あります。 そのシート

エクエルのVBAについての質問です。

一つのフォルダにエクセルシートが100個あります。
そのシート一つ一つのA11セルに
=SUM(A2:A10)
の計算式を入力するようなVBAを作ることはできないでしょうか

Aベストアンサー

できると思います。

QExcelで「令和」と表示されるのは5月1日にならないとだめですか?

「日本の新元号に関する Office の更新プログラム」というページ(下記)で、
「Windows と Office の更新プログラムを適用済みの場合でも、Windows 上で実行されている Office 製品は 2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しませんのでご注意ください。」
と書かれています。
https://support.microsoft.com/ja-jp/help/4478844/office-updates-for-new-japanese-era

今月4月中に、Excelのセルに来月5月以降の年月日を入力した場合に、自動で「令和」という元号を表示させることはできないのでしょうか。

もし、できるということであれば、「2019 年 5 月 1 日に新元号が開始されるまで、新元号を表示しません」とはどのような意味なのでしょうか。

Aベストアンサー

>こちらでは、「4月17日以降にOfficeも更新されれば「令和元年」と表示されると思います」と書かれているんですが

その方は、Microsoftの方ではないですし個人の予想ですよね?公式が出ているのにそれを持ち出してどうするんですか?

5/1より前に新しい元号を表示したい場合は数式や表示形式で限定的に表示させる方法を色々な方が考え付いていますよ。
検索すればたくさん出てきます。

Q特定の列範囲の中で最終列を指定

お世話になります。
以前質問した中で、別シートにデータを5列づつ
下に追加していくにはどうしたら良いかと言う質問をさせていただきました。

https://oshiete.goo.ne.jp/qa/11051972.html

上記回答で解決したのですが、
For j = 4 To .Cells(i, 1).End(xlToRight).Column Step unit
だと繰り返したくない列も動いてしまい、
繰り返す列範囲がD~W列のため
For j = 4 to 24 Step unit に変更しました。
すると今度は空白がある行も転記してしまい、困っています。

繰り返す範囲はD~W列まで5列毎に繰り返す
5列毎の最初のセルが空白か[0]であれば転記しない

どうぞよろしくお願いします。

Aベストアンサー

似ていますが、、、、

Sub Copies()
Const SRow = 3: Dim LRow As Long
Dim sht1 As Worksheet: Dim sht2 As Worksheet
Dim i As Long, j As Long, k As Long
Const UWide = 5
'===================
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
'===================
Application.ScreenUpdating = False
With sht1
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(SRow, 1).Resize(1, 3 + UWide).Copy sht2.Cells(1, 1)
k = 2
For i = SRow + 1 To LRow
For j = 4 To 23 Step UWide
If WorksheetFunction.CountA(.Cells(i, j).Resize(1, UWide)) > 0 Then
.Cells(i, 1).Resize(1, 3).Copy sht2.Cells(k, 1)
.Cells(i, j).Resize(1, UWide).Copy sht2.Cells(k, 4)
k = k + 1
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub

似ていますが、、、、

Sub Copies()
Const SRow = 3: Dim LRow As Long
Dim sht1 As Worksheet: Dim sht2 As Worksheet
Dim i As Long, j As Long, k As Long
Const UWide = 5
'===================
Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
'===================
Application.ScreenUpdating = False
With sht1
LRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(SRow, 1).Resize(1, 3 + UWide).Copy sht2.Cells(1, 1)
k = 2
For i = SR...続きを読む

Qエクセルのデータ抽出方法を教えてください

下記のような表から、A列のコードをもとにして「D」列の「3」行目の100、200、300(ピンク色)のセルを参照したいのですが関数がわかりません。
別のシートに10000なら100、20000なら200と表示させたいです。
vlookupでは行が1行でないとできませんでした。

Aベストアンサー

以下でいかがですか。
H2 =INDEX(E2:E13,MATCH(G2,A2:A13,0)+1)

Qエクセル リストと完全一致するセルに色をつける

シート1のA列とB列に
aaa ccc
bbb ggg
ccc kkk
ddd ooo
と言うリストがあって、A1〜A4はAチーム、B1〜B4まではBチームと名前を付けています
シート2にAチームのリスト4個が続いているものがあればセルを赤、Bチームのリスト4個が続いているものがあればセルを黄色に塗りたいです
AチームとBチームの中には同じ品番がある時もあります
条件付き書式で設定は出来るでしょうか?

Aベストアンサー

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル

 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4

 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5

 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

の4パターンについてそれぞれ調べれば良いだけ。

自分なら
 aaa-bbb-ccc-ddd
のようにシート1から文字列を作り、それが調べるセルで同じパターンになるかを調べます。
シート1はA5セルから、シート2はA11セルからデータが入力されているなら、

 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A11 & A12 & A13 & A14
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A12 & A13 & A14 & A15
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A13 & A14 & A15 & A16
 シート1!A5 & シート1!A6 & シート1!A7 & シート1!A8 = A14 & A15 & A16 & A17

という条件になる。
この4つのうちの一つでも条件を満たせばセルに赤色を付ければいい。
「Bチーム」についても同様にすればいいので、
この場合、8つの条件式を設定することになります。

面倒でもこの考え方ができていないと、ちょっと条件が変わっただけで対処できずに終わります。
冒頭で「並び順」について書きましたが、並び順がシート1のリストの通りでなくとも色を付けたい場合でも、この考え方は必要ということです。

・・・
ちなみに厄介なのが、どちらのチームにも「ccc」がいるというところかな。
これが無ければ違う方法でシンプルにできるんですけどねえ。

(´・ω・`)
”○” の数を数えるんじゃないんだよなあ。

・・・本題・・・

条件付き書式ですよね。

シート2のリストの並び順は
 aaa
 ccc
 bbb
 ddd
では「Aチーム」と認識しないという事でよろしいでしょうか?
ならば、とても簡単です。

シート2の一覧において、

 判定するセル1
 判定するセル2
 判定するセル3
 色を付けるセル
 判定するセル4
 判定するセル5
 判定するセル6

という範囲について調べれば良いという事。

 判定するセル1
 判定するセル2
 判定するセル3
 色を付け...続きを読む

Qエクセルの計算、前年との比較

ひと月を1列として、各商品ごとの重量を入力しています。
1列目1月分、2列目2月分・・・(まだ来てない月は空白)というように。
上司からの指示で、今年の今月まで累計と別シートの前年の同じ月までの累計を比較、比率を出して今年分に表示したいのですが、前年は12月まで入力しており、毎月、計算範囲を変えて、式を入力し直して計算しています。
都度書き換えずに、たとえば関数などで対処できないかと思うのですが、いい方法が浮かびません。
どなたかお知恵をお貸しください。

Aベストアンサー

添付画像のようなこともできますよ。
これは、M1セルに入力した月までの累計をM3に表示するものです。
M3セルに、次の式を設定しています。
=SUM(OFFSET(A3,0,0,1,M1))


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング