アプリ版:「スタンプのみでお礼する」機能のリリースについて

Excelのマクロを使用して以下の内容をしたいのですがどのようにすれば宜しいでしょうか?

1)「Sheet1」のセルの値が>2(2より大きい)の場合に「Sheet2」の同一のセルの色を例えば赤色にする。
これをA1~N34までのセルに関して連続で実行したい。

2)「X」というファイルのSheet1 A1からN34セルに同一のフォルダーに入っている、他のファイルの同セルに値が記載されていれば、その値をコピーしたい。
フォルダーに次々とファイルが追加されていくことを想定し、できれば他のファイル名は指定しなくてもどんどんコピーできるマクロがあればいいと思うのですが・・・

すみませんが宜しくお願いいたします。

A 回答 (5件)

んー? 情報提供の不足は色々ありますが,特に難しい内容では無さそうに思えましたが。



sub macro1()
 dim s as string
 dim myPath as string

 myPath = thisworkbook.path & "\"
 s = dir(mypath & "*.xls")

 application.displayalerts = false
 application.screenupdating = false

 do
 if s <> thisworkbook.name then
  workbooks.open filename:=mypath & s

  'コピーしてきたいシートの具体的な詳細が不明
  workbooks(s).worksheets(1).range("A1:N34").copy

  '肝心の,どう貼りたいのか,重なったらどうしたいのか等の詳細一切不明
  thisworkbook.worksheets("Sheet1").range("A1").pastespecial _
   Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=False
  workbooks(s).close savechanges:=false
 end if
 s = dir()
 loop until s = ""

 application.screenupdating = true
 application.displayalerts = true
end sub



>色塗り

別にマクロとか使わなくても,シート2のセル範囲を選んで
条件付き書式を取り付けて
セルの値が → 数式が に変えて
右の空欄に
=INDIRECT("Sheet1!RC",FALSE)>2
と記入して,書式ボタンでセルの色を赤く塗って出来上がり。です。
    • good
    • 0

こんばんは!


とりあえず、(1)に関してですが・・・

Sub test()
Dim i, j As Long
For i = 1 To 34
For j = 1 To 14
If Worksheets("sheet1").Cells(i, j) > 2 Then
Worksheets("sheet2").Cells(i, j).Interior.ColorIndex = 3
End If
Next j
Next i
End Sub

こんな感じですかね?

(2)に関してはちょっと判りかねますので
この程度でごめんなさいね。m(__)m
    • good
    • 0

Ano2の1)はSheet1のマクロに作成する、それ以外の所にする場合には



For Each m_Range In Worksheets("Sheet1").Range("A1:N34")

としてください。
    • good
    • 0

1)


Sub MacroX()

Dim m_Range As Object

For Each m_Range In Range("A1:N34")
If m_Range.Value > 2 Then
Worksheets("Sheet2").Range(m_Range.Address).Interior.Color = vbRed
End If
Next

End Sub

2)
仕様があいまいです
どんどんコピーするとは、たとえばAファイルのA1にデータがありBファイルのA1にデータがあった場合どちらを優先させるのかが不明です。
一度確認したファイルは次の実行時に値をコピーするのかも不明です。
コピーしないとすれば確認したかどうかをどこに記憶しておいて良いのか。
再度流れをじっくり考えて仕様をねってみましょう。
    • good
    • 0

とりあえず1です。



Sub aaa()
Dim r As Integer, c As Integer
For c = 1 To 14
   For r = 1 To 34
      If Worksheets("Sheet1").Cells(r, c).Value > 2 Then
         Worksheets("Sheet2").Cells(r, c).Interior.ColorIndex = 3
      End If
   Next r
Next c

End Sub
    • good
    • 0

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