How to define a Rule to match a Head except if it is a Part of another?

You can use the fact that once an object is replaced, it doesn't get replaced by any further rules. So, just add a rule that replaces a DateObject with itself:

expr = {1 -> a, 2 -> b, 3 -> c, 4 -> {5 -> d, 6 -> e, 7 -> Today}, 8 -> Yesterday, 9 -> {10 -> f, 11 -> {12 -> Tomorrow, 13 -> g}}}l
expr /. {a_DateObject :> a, List -> Framed@*Column@*List}

We can get the desired result using Replace in several ways:

1. We can temporarily change the behavior of Framed inside expressions with head DateObject (using Block and TagSetDelayed):

Block[{Framed}, 
 Framed /: DateObject[Framed[a_], b___] := DateObject[First @ a, b]; 
 Replace[expr, a_List :> Framed[Column @ a], All]]

Alternatively,

Block[{Framed}, 
 Framed /: DateObject[Framed[Column[a_]], b___] := DateObject[a, b];
 Replace[expr, a_List :> Framed[Column@a], All]]

same picture

2. Alternatively, we can use two replacement rules where the second rule undoes the replacements inside DateObjects effected by the first rule:

Replace[expr, {a_List :> Framed[Column@a], d_DateObject :> (d /. Framed -> First)}, All]

Alternatively,

Replace[expr, {List -> Framed@*Column@*List, 
  DateObject -> (DateObject[##] /. Framed -> First &)}, All, Heads -> True]

same picture

Note the need to use the option Heads -> True in the second approach.

Another option is Developer`ReplaceAllUnheld.

expr = {1 -> a, 2 -> b, 3 -> c, 4 -> {5 -> d, 6 -> e, 7 -> Today}, 8 -> Yesterday, 
   9 -> {10 -> f, 11 -> {12 -> Tomorrow, 13 -> g}}};

Block[{DateObject},
 Attributes[DateObject] = HoldAll; 
 Developer`ReplaceAllUnheld[expr, List -> Framed@*Column@*List]
]

Also see What is the potential usage of ReplaceAllUnheld in Developer Utilities Package?